1 Abstract


We perceive and memorize a set of continuous events as a narrative with plot structure, such as exposition, complication, climax, and resolution. Although many previous studies investigated how the brain constructs a unitary representation of a visual object consisting of many different parts, few studies examined how a temporal structure of narratives is represented in the brain. Here we investigated if the narrative structure can be decoded based on functional connectivity information acquired while participants are watching short film animations. These films were divided into an early (exposition and complication) and a later part (climax and resolution) by independent raters, and fMRI data during film watching were split into the two parts accordingly. Each of the splits was transformed into a functional connectivity matrix, and we tested whether the temporal structure (i.e., early, or later part) can be decoded based on the connectivity information using representational similarity and multivariate classification analyses. We could successfully decode the temporal structure of the narratives in both analyses: That is, irrespective of the contents, early and later parts of narratives had differential connectivity patterns from each other. Interestingly, the temporal structure decoding was also successful even when the same analyses were performed “across participants”. In a subsequent analysis, we found that the narrative structure information was predominantly represented in the visual, fronto-parietal, default mode networks. Our findings show that network-level interactions in the brain support representation of narrative structure independent from contents of narratives and individual difference in functional connectivity.






2 Preparation


set.seed(12345) # for reproducibility
options(knitr.kable.NA = '')

# install // load packages 
# Some packages need to be loaded. 
# We use `pacman` as a package manager, which takes care of the other packages. 
if (!require("distill", quietly = TRUE)) install.packages("distill")
if (!require("devtools", quietly = TRUE)) install.packages("devtools")
if (!require("papaja", quietly = TRUE)) devtools::install_github("crsh/papaja")
if (!require("patchwork", quietly = TRUE)) devtools::install_github("thomasp85/patchwork")
if (!require("klippy", quietly = TRUE)) devtools::install_github("RLesur/klippy")
if (!require("pacman", quietly = TRUE)) install.packages("pacman")
if (!require("Rmisc", quietly = TRUE)) install.packages("Rmisc")
if (!require("rstatix", quietly = TRUE)) install.packages("rstatix")
if (!require("effsize", quietly = TRUE)) install.packages("effsize")
if (!require("lsr", quietly = TRUE)) install.packages("lsr")
if (!require("effectsize", quietly = TRUE)) install.packages("effectsize")
if (!require("ggbeeswarm", quietly = TRUE)) install.packages("ggbeeswarm") # Never load it directly.
pacman::p_load(tidyverse, papaja, knitr, dplyr, car, psych, afex, lme4, lmerTest, 
               emmeans, ggplot2, ggpubr, lattice, latticeExtra, parallel, 
               effects, psycho, caret, sjPlot, ppcor, rstatix)
library("patchwork"); library("klippy")
klippy::klippy()
targ_sn = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 13, 14, 15 ,16, 17, 18, 19, 20, 21)
# 12 제외




3 Stimiulus Check


참가자들은 스캐너 안에서 총 30개의 짧은 이야기 영상을 보았다. 이야기의 시간 흐름을 추적하기 위해, 각 이야기는 별도의 평정자들에 의해 발단과 전개를 포함하는 전반부와 전환과 결말을 포함하는 후반부로 분할되었다. 분할된 영상의 구획별 지속 시간이 서로 큰 차이를 가지는 경우 기능적 연결성이 잘못 추정될 가능성이 있다. 이러한 가능성을 확인하기 위해 구획의 전반부, 후반부 간 지속 시간 차이를 분석하였다.


fMRI TR(2000ms) 별로 분석한 요약치는 아래와 같다.


s1 <- read.csv("data/stim_info_cal_2pt.csv", header = T)
s1$idx = factor(s1$idx)

## 3 part
s2 <- s1 %>% dplyr::select(idx, durTR, dur_p1_tr, dur_p2_tr)
s2 <- gather(s2, key = part, value = tr, dur_p1_tr:dur_p2_tr, factor_key=T)
s2$part <- factor(s2$part, levels=c("dur_p1_tr", "dur_p2_tr"),
                  labels = c("p1", "p2"))
glimpse(s2, width = 70)
## Rows: 60
## Columns: 4
## $ idx   <fct> 2, 9, 10, 13, 15, 24, 25, 33, 44, 49, 58, 62, 68, 74, …
## $ durTR <int> 99, 75, 106, 83, 85, 105, 102, 92, 88, 88, 78, 71, 111…
## $ part  <fct> p1, p1, p1, p1, p1, p1, p1, p1, p1, p1, p1, p1, p1, p1…
## $ tr    <int> 64, 21, 43, 50, 53, 77, 44, 39, 53, 45, 45, 40, 34, 37…

s2.w <- s2 %>% spread(key = part, value = tr)

s2.G <- s2 %>% group_by(part) %>% rstatix::get_summary_stats(tr)
s2.G %>% kable(digits = 2)
part variable n min max median q1 q3 iqr mad mean sd se ci
p1 tr 30 21 77 45 39.00 53.00 14.0 11.86 46.13 11.57 2.11 4.32
p2 tr 30 31 77 53 39.25 61.75 22.5 17.05 51.77 13.93 2.54 5.20


library(RColorBrewer)
s.plot <- ggplot(data=s2, aes(x=part, y=tr, fill=part)) +
  stat_summary(fun = mean, geom = "bar", position="dodge",
               na.rm = TRUE, alpha = .9, width = 0.8,  
               color="black", size = 0.15) +
  geom_point(data=s2, aes(x=part, y=tr, fill=part), position = position_dodge(width=0.8),
             size=2, show.legend=F, color="gray90") +
  geom_segment(data=s2.w, inherit.aes = FALSE,
               aes(x=1, y=filter(s2.w)$p1,
                   xend=2, yend=filter(s2.w)$p2),
               color="gray90", alpha = .7) +
  geom_errorbar(data=s2.G, 
                aes(x = part, y=mean, ymin = mean - ci, ymax = mean + ci), width=.2,
                position=position_dodge(.8), color = "black") +
  coord_cartesian(ylim = c(0, 100), clip = "on") +
  scale_fill_manual(values = c("#ED7D31", "#5B9BD5"), # c("#ED7D31", "#5B9BD5", "#70AD47"),
                    labels = c("First Half", "Second Half")) +
  # scale_fill_brewer(palette="Set2", labels = c("Part 1", "Part 2")) + 
  labs(x = "Part", y = "Duration (TR)") +
  theme_bw(base_size = 18) +
  theme(axis.title = element_text(face = "bold", size = 16, color = "black"),
        axis.text.x=element_blank(),
        axis.ticks.x=element_blank(),
        # axis.text = element_text(face = "plain", size = 15, color = "black"),
        # axis.text.x = element_text(face = "plain", size = 15, color = "black"),
        axis.line=element_line(),
        strip.text.x = element_text(face = "plain", size = 15, color = "black"),
        strip.background = element_blank(),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.border = element_blank(),
        panel.spacing=unit(1, "lines"),
        plot.margin = margin(1, 0.3, 1, 0.3, "cm"), 
        legend.title = element_blank(),
        legend.position=c(0.8, 0.85))
s.plot


전반부와 후반부 간 지속 시간 차이는 통계적으로 유의하지 않았다. 따라서 아래의 분석 결과에 지속 시간의 차이가 체계적인 영향을 주었을 가능성은 적다.


s2.aov <- s2 %>% anova_test(tr ~ part + Error(idx/part), detailed = F)
get_anova_table(s2.aov, correction = "GG") %>% kable(digits=2)
Effect DFn DFd F p p<.05 ges
part 1 29 2.12 0.16 0.05

p_h1 <- s2 %>% rstatix::pairwise_t_test(tr ~ part, 
                                p.adjust.method="holm", 
                                paired=T, detailed=T) %>% 
  dplyr::select(group1, group2, estimate, conf.low, conf.high, df, statistic, p.adj, p.adj.signif) 
p_h2 <- s2 %>% 
  rstatix::cohens_d(tr ~ part, paired=T, ci = F) %>%
  dplyr::select(group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("group1", "group2")) %>% kable(digits=3)
group1 group2 estimate conf.low conf.high df statistic p.adj p.adj.signif effsize magnitude
p1 p2 -5.633 -13.553 2.286 29 -1.455 0.156 ns -0.266 small




4 Behavior Results


기능적 연결성 분석에 앞서 참가자들이 영상을 성실히 보았는지, 제대로 이해하며 보았는지 정도를 확인할 필요가 있다. 스캔 세션이 끝난 후, 참가자들이 영상을 제대로 이해하며 보았는지 여부를 별도의 행동 검사를 통해 확인하였다. 영상 별로 이야기 흐름에 따라 구분되는 3개의 스틸컷을 준비하였고, 참가자들은 각 스틸컷을 시간 순서에 따라 재배열하였다. 이에 더하여, 해당 영상이 이해가 잘되었는지의 정도를 평정하였다. 마지막으로 영상을 보는 도중 집중하지 않았거나 존 경우, 별도로 체크하였다 (check = 1(성실히 보지않은 경우) or 0(성실히 본 경우)).


bh <- read.csv("data/aniFCnet_behav.csv", header = T)
glimpse(bh, width = 80)
## Rows: 630
## Columns: 7
## $ Idx         <int> 26, 21, 12, 22, 7, 6, 4, 30, 29, 14, 5, 10, 28, 17, 19, 15…
## $ num         <int> 26, 21, 12, 22, 7, 6, 4, 30, 29, 14, 5, 10, 28, 17, 19, 15…
## $ stimIdx     <int> 2, 9, 10, 13, 15, 24, 25, 33, 44, 49, 58, 62, 68, 74, 81, …
## $ sn          <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1…
## $ correctness <int> 1, 1, 0, 0, 1, 1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1…
## $ scores      <int> 9, 9, 1, 1, 7, 9, 9, 1, 1, 7, 8, 9, 6, 6, 8, 9, 9, 6, 9, 6…
## $ check       <int> 0, 0, 1, 1, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…

bh_l <- bh %>% filter(sn %in% targ_sn)
bh_l$sn = factor(bh_l$sn)
bh_l$stimIdx = factor(bh_l$stimIdx)
bh_l$corr = bh_l$correctness

bh_t <- bh_l %>% dplyr::select(sn, stimIdx, corr, scores, check)


영상을 제대로 보지 않은 것으로 체크된 경우를 요약하였다.


bh_1 <- bh_l %>% filter(check == 0)

# mean number of trials for each conditions
bh_1 %>% group_by(sn) %>%
  dplyr::summarise(NumTrial = length(corr)) %>%
  ungroup() %>%
  dplyr::summarise(Mean = mean(NumTrial),
                   Median = median(NumTrial),
                   Min = min(NumTrial),
                   Max = max(NumTrial), 
                   OutN = sum(NumTrial),
                   TotalN = (30*length(sn)),
                   OutProp = 100 - sum(NumTrial)/(30*length(sn))*100 ) %>%
  ungroup %>%
  kable(digits=2)
Mean Median Min Max OutN TotalN OutProp
28.45 29 25 30 569 600 5.17

bh_1 %>% group_by(sn) %>%
  dplyr::summarise(NumTrial = length(corr)) %>%
  ungroup() %>% spread(key = sn, value = NumTrial) %>% 
  kable(digits=2)
1 2 3 4 5 6 7 8 9 10 11 13 14 15 16 17 18 19 20 21
25 30 29 30 30 26 27 30 29 28 29 29 30 27 29 25 28 30 30 28


4.1 By Subject, Accuracy


영상을 보았지만 이야기를 잘 이해하지 못한 경우, 즉, 스틸컷 순서 맞추기 검사에서 틀린 경우를 요약하였다. 여기서 영상을 성실히 보지 않은 경우(check = 0)는 틀린 것으로 처리하였다. 그 결과, 최소 75% 이상의 정확도를 보였다.


bh_2 <- bh_l %>% filter(corr == 1)


# mean number of trials for each conditions
bh_2 %>% group_by(sn) %>%
  dplyr::summarise(NumTrial = length(corr)) %>%
  ungroup() %>%
  dplyr::summarise(Mean = mean(NumTrial),
                   Median = median(NumTrial),
                   Min = min(NumTrial),
                   Max = max(NumTrial), 
                   OutN = sum(NumTrial),
                   TotalN = (30*length(sn)),
                   OutProp = 100 - sum(NumTrial)/(30*length(sn))*100 ) %>%
  ungroup %>%
  kable(digits=2)
Mean Median Min Max OutN TotalN OutProp
27.6 28 24 30 552 600 8

bh_2 %>% group_by(sn) %>%
  dplyr::summarise(NumTrial = length(corr)) %>%
  ungroup() %>% spread(key = sn, value = NumTrial) %>% 
  kable(digits=2)
1 2 3 4 5 6 7 8 9 10 11 13 14 15 16 17 18 19 20 21
25 29 30 24 29 29 29 29 29 27 28 27 30 26 25 27 28 27 26 28



bh_3 <- bh_l
# glimpse(bh_1)
# subject-level, long format
bh_allL <- bh_3 %>% group_by(sn) %>%
  dplyr::summarise(acc=mean(corr)*100) %>%
  ungroup()
# bh_allL %>% kable(digits=2)

bh_allL.1 <- bh_allL %>% 
  nest() %>%
  mutate(lbound = map(data, ~mean(.$acc)-2*sd(.$acc)),
         ubound = map(data, ~mean(.$acc)+2*sd(.$acc))) %>% # make new data (3sd cut)
  unnest(c(lbound, ubound))%>% 
  unnest(data) %>% 
  mutate(Outlier = (acc < lbound)|(acc > ubound))
## Warning: `...` must not be empty for ungrouped data frames.
## Did you want `data = everything()`?
  #filter(Outlier == FALSE) %>% # filtering outlier
  

# subject-level, wide format
bh_allG <- rstatix::get_summary_stats(bh_allL) %>%
  mutate(acc.m = mean, acc.sd = sd, acc.se = se, acc.ci = ci) %>%
  dplyr::select(acc.m, acc.sd, acc.se, acc.ci)
bh_allG <- bh_allG %>% 
  mutate(lower.ci = acc.m-acc.ci,
         upper.ci = acc.m+acc.ci,
         lower.se = acc.m-acc.se,
         upper.se = acc.m+acc.se)

bh_allL %>% spread(key = sn, value = acc) %>% kable(digits=1)
1 2 3 4 5 6 7 8 9 10 11 13 14 15 16 17 18 19 20 21
83.3 96.7 100 80 96.7 96.7 96.7 96.7 96.7 90 93.3 90 100 86.7 83.3 90 93.3 90 86.7 93.3
bh_allG %>% kable(digits=2)
acc.m acc.sd acc.se acc.ci lower.ci upper.ci lower.se upper.se
92 5.76 1.29 2.7 89.3 94.7 90.71 93.29


bh_allG$x <- 1
bh_allG$x <- factor(bh_allG$x)
bh.plot1 <- ggplot(data=bh_allG, aes(x=x, y=acc.m)) +
  stat_summary(fun = mean, geom = "bar", position="dodge", fill="gray70",
               na.rm = TRUE, alpha = .9, width = 0.7,  color="black", size = 0.15) +
  geom_errorbar(data=bh_allG, 
                aes(x = 1, y=acc.m, ymin = acc.m - acc.ci, ymax = acc.m + acc.ci), width=.2,
                position=position_dodge(.8), color = "black") +
  geom_hline(yintercept=70, linetype='dashed', color='darkred', alpha =1, size=1) +
  coord_cartesian(ylim = c(0, 100), clip = "on") +
  # coord_cartesian(ylim = c(0, 5), clip = "on") +
  labs(x = "Group", y = "Mean Accuracy (%)") +
  # scale_x_discrete(labels=c("Summary")) +
  theme_bw(base_size = 18) +
  theme(axis.title = element_text(face = "bold", size = 16, color = "black"),
        axis.text.x=element_blank(),
        axis.ticks.x=element_blank(),
        axis.line=element_line(),
        strip.text.x = element_text(face = "plain", size = 15, color = "black"),
        strip.background = element_blank(),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.border = element_blank(),
        panel.spacing=unit(1, "lines"),
        plot.margin = margin(1, 0.3, 1, 0.3, "cm"), 
        legend.title = element_blank(),
        legend.position=c(0.8, 0.85))
# bh.plot1

bh.plot2 <- ggplot(data=bh_allL, aes(x=sn, y=acc)) +
  stat_summary(fun = mean, geom = "bar", position="dodge", fill="gray70",
               na.rm = TRUE, alpha = .9, width = 0.8,  color="black", size = 0.15) +
  geom_hline(yintercept=60, linetype='dashed', color='darkred', alpha =1, size=1) +
  coord_cartesian(ylim = c(0, 100), clip = "on") +
  # coord_cartesian(ylim = c(0, 5), clip = "on") +
  labs(x = "Subject Number", y = "Accuracy (%)") +
  theme_bw(base_size = 18) +
  theme(axis.title = element_text(face = "bold", size = 16, color = "black"),
        axis.text = element_text(face = "plain", size = 15, color = "black"),
        axis.text.x = element_text(face = "plain", size = 15, color = "black"),
        axis.line=element_line(),
        strip.text.x = element_text(face = "plain", size = 15, color = "black"),
        strip.background = element_blank(),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.border = element_blank(),
        panel.spacing=unit(1, "lines"),
        plot.margin = margin(1, 0.3, 1, 0.3, "cm"), 
        legend.title = element_blank(),
        legend.position=c(0.8, 0.85))
# bh.plot2

bh.plot <- ggarrange(bh.plot1, bh.plot2, ncol = 2, widths = c(1,3), 
                     labels = c("A", "B"))
bh.plot


4.2 By Subject, Comprehension Score


각 참가자들이 영상이 이해가 잘되었는지의 정도를 평정한 결과를 요약하였다. 여기서 점수가 높을수록 이해가 잘되었음을 나타낸다.


# subject-level, long format
bh_allL <- bh_1 %>% group_by(sn) %>%
  dplyr::summarise(score=mean(scores)) %>%
  ungroup()
# bh_allL %>% kable(digits=2)

# subject-level, wide format
bh_allG <- rstatix::get_summary_stats(bh_allL) %>%
  mutate(score.m = mean, score.sd = sd, score.se = se, score.ci = ci) %>%
  dplyr::select(score.m, score.sd, score.se, score.ci)
bh_allG <- bh_allG %>% 
  mutate(lower.ci = score.m-score.ci,
         upper.ci = score.m+score.ci,
         lower.se = score.m-score.se,
         upper.se = score.m+score.se)

bh_allL %>% spread(key = sn, value = score) %>% kable(digits=2)
1 2 3 4 5 6 7 8 9 10 11 13 14 15 16 17 18 19 20 21
7.76 8.5 8.48 8.2 7.5 8.31 8.48 6.7 8.38 8.29 8.83 7.48 8.73 8.67 5.52 7.2 8.5 8.1 8.23 7.32
bh_allG %>% kable(digits=2)
score.m score.sd score.se score.ci lower.ci upper.ci lower.se upper.se
7.96 0.81 0.18 0.38 7.58 8.34 7.78 8.14


bh_allG$x <- 1
bh_allG$x <- factor(bh_allG$x)
bh.plot1 <- ggplot(data=bh_allG, aes(x=x, y=score.m)) +
  stat_summary(fun = mean, geom = "bar", position="dodge", fill="gray70",
               na.rm = TRUE, alpha = .9, width = 0.7,  color="black", size = 0.15) +
  geom_errorbar(data=bh_allG, 
                aes(x = 1, y=score.m, ymin = score.m - score.ci, ymax = score.m + score.ci), width=.2,
                position=position_dodge(.8), color = "black") +
  geom_hline(yintercept=60, linetype='dashed', color='darkred', alpha =1, size=1) +
  coord_cartesian(ylim = c(1, 9), clip = "on") +
  # coord_cartesian(ylim = c(0, 5), clip = "on") +
  labs(x = "Group", y = "Mean Score") +
  scale_y_continuous(breaks = seq(0, 9, by = 1)) +
  # scale_x_discrete(labels=c("Summary")) +
  theme_bw(base_size = 18) +
  theme(axis.title = element_text(face = "bold", size = 16, color = "black"),
        axis.text.x=element_blank(),
        axis.ticks.x=element_blank(),
        axis.line=element_line(),
        strip.text.x = element_text(face = "plain", size = 15, color = "black"),
        strip.background = element_blank(),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.border = element_blank(),
        panel.spacing=unit(1, "lines"),
        plot.margin = margin(1, 0.3, 1, 0.3, "cm"), 
        legend.title = element_blank(),
        legend.position=c(0.8, 0.85))
# bh.plot1

bh.plot2 <- ggplot(data=bh_allL, aes(x=sn, y=score)) +
  stat_summary(fun = mean, geom = "bar", position="dodge", fill="gray70",
               na.rm = TRUE, alpha = .9, width = 0.8,  color="black", size = 0.15) +
  geom_hline(yintercept=60, linetype='dashed', color='darkred', alpha =1, size=1) +
  coord_cartesian(ylim = c(1, 9), clip = "on") +
  scale_y_continuous(breaks = seq(1, 9, by = 1)) +
  # coord_cartesian(ylim = c(0, 5), clip = "on") +
  labs(x = "Subject Number", y = "Score") +
  theme_bw(base_size = 18) +
  theme(axis.title = element_text(face = "bold", size = 16, color = "black"),
        axis.text = element_text(face = "plain", size = 15, color = "black"),
        axis.text.x = element_text(face = "plain", size = 15, color = "black"),
        axis.line=element_line(),
        strip.text.x = element_text(face = "plain", size = 15, color = "black"),
        strip.background = element_blank(),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.border = element_blank(),
        panel.spacing=unit(1, "lines"),
        plot.margin = margin(1, 0.3, 1, 0.3, "cm"), 
        legend.title = element_blank(),
        legend.position=c(0.8, 0.85))
# bh.plot2

bh.plot <- ggarrange(bh.plot1, bh.plot2, ncol = 2, widths = c(1,3), 
                     labels = c("A", "B"))
bh.plot




5 Image Quality Assessment


기능적 연결성 분석의 대상이 되는 fMRI time-course data는 스캔 중 참가자들의 움직임에 민감하다. 만약 스캔 중 과도한 움직임이 있는 경우, time-course data를 왜곡할 수 있고 기능적 연결성이 잘못 추정될 수 있다. 이를 위해 fMRI 전처리 과정에 움직임을 보정하는 단계(motion correction, denoising step)를 거치나, 움직임이 많은 경우, 보정 과정에서 과도하게 많은 데이터를 제거할 가능성이 있다. 이러한 가능성을 확인하기 위해, 각 영상의 TR 별로 Framewise Displacement를 계산하고, 사전에 정해진 역치를 초과하는지, 전/후반부 간 과도한 차이가 있는지 확인하였다.


# qa1 <- read.csv("fd_byRun_opt3.csv", header = T)
qa1 <- read.csv("data/fd_byIdx_opt3.csv", header = T)

glimpse(qa1, width = 80)
## Rows: 630
## Columns: 8
## $ sn      <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,…
## $ run     <int> 1, 10, 8, 6, 1, 6, 3, 6, 8, 3, 2, 7, 7, 4, 9, 10, 9, 8, 3, 5, …
## $ idx     <int> 2, 9, 10, 13, 15, 24, 25, 33, 44, 49, 58, 62, 68, 74, 81, 86, …
## $ stim_fd <dbl> 0.05841905, 0.08808869, 0.14467205, 0.14675789, 0.06882145, 0.…
## $ p1_fd   <dbl> 0.05311265, 0.08460212, 0.11705558, 0.14284837, 0.07651832, 0.…
## $ p2_fd   <dbl> 0.06754991, 0.09158456, 0.15771316, 0.14960857, 0.06197980, 0.…
## $ count   <int> 0, 4, 20, 19, 0, 24, 2, 21, 19, 1, 0, 0, 29, 35, 5, 4, 7, 10, …
## $ prop    <dbl> 0.000000, 5.333333, 18.867925, 22.891566, 0.000000, 22.857143,…

qa1_l <- qa1 %>% filter(sn %in% targ_sn)
qa1_l$sn = factor(qa1_l$sn)
qa1_l$run = factor(qa1_l$run)
qa1_l$idx = factor(qa1_l$idx)
# qa1_l <- gather(qa1_l, key = part, value = fd, all_fd:p2_fd)
qa1_l <- gather(qa1_l, key = part, value = fd, stim_fd:p2_fd)
# qa1_l$part <- factor(qa1_l$part, 
#                      levels = c('all_fd', 'stim_fd', 'p1_fd', 'p2_fd'),
#                      labels = c('all', 'stim', 'p1', 'p2'))
qa1_l$part <- factor(qa1_l$part, 
                     levels = c('stim_fd', 'p1_fd', 'p2_fd'),
                     labels = c('stim', 'p1', 'p2'))


qa1_t <- qa1_l %>% dplyr::select(sn, run, idx, part, fd, count, prop)

bh_tt <- bh_t
bh_tt$idx <- bh_tt$stimIdx
bh_tt <- bh_tt %>% dplyr::select(sn, idx, corr, check)

qa1_t <- merge(qa1_t, bh_tt, by= c('sn', 'idx'))
qa1_t <- qa1_t %>% filter(check == 0) %>% filter(corr == 1)


5.1 By Subject, Framewise Displacement


각 영상별 지속 시간에서 Framewise Displacement가 0.2mm를 초과하는 경우가 있는지를 참가자별로 요약하였다. 분석 결과, 평균 FD가 0.2mm 를 초과하는 참가자는 관찰되지 않았다.



# glimpse(qa1_1)
# subject-level, long format
# qa1_allL <- qa1_t %>% dplyr::filter(run == 0, part == 'stim') %>% group_by(sn) %>%
#   dplyr::summarise(fd=mean(fd)) %>%
#   ungroup()
qa1_allL <- qa1_t %>% dplyr::filter(part == 'stim') %>% group_by(sn) %>%
  dplyr::summarise(fd=mean(fd)) %>%
  ungroup()

# qa1_allL %>% kable(digits=2)

# subject-level, wide format
qa1_allG <- rstatix::get_summary_stats(qa1_allL) %>%
  mutate(fd.m = mean, fd.sd = sd, fd.se = se, fd.ci = ci) %>%
  dplyr::select(fd.m, fd.sd, fd.se, fd.ci)
qa1_allG <- qa1_allG %>% 
  mutate(lower.ci = fd.m-fd.ci,
         upper.ci = fd.m+fd.ci,
         lower.se = fd.m-fd.se,
         upper.se = fd.m+fd.se)

qa1_allL %>% spread(key = sn, value = fd) %>% kable(digits=2)
1 2 3 4 5 6 7 8 9 10 11 13 14 15 16 17 18 19 20 21
0.1 0.18 0.06 0.11 0.11 0.06 0.05 0.05 0.06 0.08 0.1 0.17 0.04 0.09 0.11 0.05 0.06 0.1 0.12 0.05
qa1_allG %>% kable(digits=2)
fd.m fd.sd fd.se fd.ci lower.ci upper.ci lower.se upper.se
0.09 0.04 0.01 0.02 0.07 0.11 0.08 0.1


qa1_allG$x <- 1
qa1_allG$x <- factor(qa1_allG$x)
qa1.plot1 <- ggplot(data=qa1_allG, aes(x=x, y=fd.m)) +
  stat_summary(fun = mean, geom = "bar", position="dodge", fill="gray70",
               na.rm = TRUE, alpha = .9, width = 0.7,  color="black", size = 0.15) +
  geom_errorbar(data=qa1_allG, 
                aes(x = 1, y=fd.m, ymin = fd.m - fd.ci, ymax = fd.m + fd.ci), width=.2,
                position=position_dodge(.8), color = "black") +
  geom_hline(yintercept=0.2, linetype='dashed', color='darkred', alpha =1, size=1) +
  coord_cartesian(ylim = c(0, 0.3), clip = "on") +
  # coord_cartesian(ylim = c(0, 5), clip = "on") +
  labs(x = "Group", y = "Mean FD value") +
  # scale_x_discrete(labels=c("Summary")) +
  theme_bw(base_size = 18) +
  theme(axis.title = element_text(face = "bold", size = 16, color = "black"),
        axis.text.x=element_blank(),
        axis.ticks.x=element_blank(),
        axis.line=element_line(),
        strip.text.x = element_text(face = "plain", size = 15, color = "black"),
        strip.background = element_blank(),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.border = element_blank(),
        panel.spacing=unit(1, "lines"),
        plot.margin = margin(1, 0.3, 1, 0.3, "cm"), 
        legend.title = element_blank(),
        legend.position=c(0.8, 0.85))
# qa1.plot1

qa1.plot2 <- ggplot(data=qa1_allL, aes(x=sn, y=fd)) +
  stat_summary(fun = mean, geom = "bar", position="dodge", fill="gray70",
               na.rm = TRUE, alpha = .9, width = 0.8,  color="black", size = 0.15) +
  geom_hline(yintercept=0.2, linetype='dashed', color='darkred', alpha =1, size=1) +
  coord_cartesian(ylim = c(0, 0.3), clip = "on") +
  # coord_cartesian(ylim = c(0, 5), clip = "on") +
  labs(x = "Subject Number", y = "FD value") +
  theme_bw(base_size = 18) +
  theme(axis.title = element_text(face = "bold", size = 16, color = "black"),
        axis.text = element_text(face = "plain", size = 15, color = "black"),
        axis.text.x = element_text(face = "plain", size = 15, color = "black"),
        axis.line=element_line(),
        strip.text.x = element_text(face = "plain", size = 15, color = "black"),
        strip.background = element_blank(),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.border = element_blank(),
        panel.spacing=unit(1, "lines"),
        plot.margin = margin(1, 0.3, 1, 0.3, "cm"), 
        legend.title = element_blank(),
        legend.position=c(0.8, 0.85))
# qa1.plot2

qa1.plot <- ggarrange(qa1.plot1, qa1.plot2, ncol = 2, widths = c(1,3), 
                      labels = c("A", "B"))
qa1.plot


5.2 By Subject, Proportion of Outlier TRs (FD 0.2<)


평균 FD 분석에 더하여, 영상의 TR별로 FD가 0.2mm 를 초과하는 경우가 개별 영상의 전체 지속 시간에서 어느 정도 비율을 차지하는지 참가자별로 요약하였다. FD가 0.2mm를 초과하는 TR의 비율이 50% 를 초과하는 참가자는 관찰되지 않았다.



# glimpse(qa1_1)
# subject-level, long format
# qa1_allL <- qa1_t %>% dplyr::filter(run == 0, part == 'all') %>% group_by(sn) %>%
#   dplyr::summarise(prop=mean(prop)) %>%
#   ungroup()
qa1_allL <- qa1_t %>% dplyr::filter(part == 'stim') %>% group_by(sn) %>%
  dplyr::summarise(prop=mean(prop)) %>%
  ungroup()

# qa1_allL %>% kable(digits=2)

# subject-level, wide format
qa1_allG <- rstatix::get_summary_stats(qa1_allL) %>%
  mutate(prop.m = mean, prop.sd = sd, prop.se = se, prop.ci = ci) %>%
  dplyr::select(prop.m, prop.sd, prop.se, prop.ci)
qa1_allG <- qa1_allG %>% 
  mutate(lower.ci = prop.m-prop.ci,
         upper.ci = prop.m+prop.ci,
         lower.se = prop.m-prop.se,
         upper.se = prop.m+prop.se)

qa1_allL %>% spread(key = sn, value = prop) %>% kable(digits=2)
1 2 3 4 5 6 7 8 9 10 11 13 14 15 16 17 18 19 20 21
9.78 21.87 0.03 7.88 6.98 0.6 1.53 0 0.34 0.66 0.64 26.66 0 2.48 9.61 0.24 0.94 4.64 6.78 0.04
qa1_allG %>% kable(digits=2)
prop.m prop.sd prop.se prop.ci lower.ci upper.ci lower.se upper.se
5.08 7.43 1.66 3.48 1.61 8.56 3.42 6.75


qa1_allG$x <- 1
qa1_allG$x <- factor(qa1_allG$x)
qa1.plot1 <- ggplot(data=qa1_allG, aes(x=x, y=prop.m)) +
  stat_summary(fun = mean, geom = "bar", position="dodge", fill="gray70",
               na.rm = TRUE, alpha = .9, width = 0.7,  color="black", size = 0.15) +
  geom_errorbar(data=qa1_allG, 
                aes(x = 1, y=prop.m, ymin = prop.m - prop.ci, ymax = prop.m + prop.ci), width=.2,
                position=position_dodge(.8), color = "black") +
  geom_hline(yintercept=50, linetype='dashed', color='darkred', alpha =1, size=1) +
  # coord_cartesian(ylim = c(0, 0.3), clip = "on") +
  # coord_cartesian(ylim = c(0, 5), clip = "on") +
  labs(x = "Group", y = "Mean Proportion of Outliers (%)") +
  # scale_x_discrete(labels=c("Summary")) +
  theme_bw(base_size = 18) +
  theme(axis.title = element_text(face = "bold", size = 16, color = "black"),
        axis.text.x=element_blank(),
        axis.ticks.x=element_blank(),
        axis.line=element_line(),
        strip.text.x = element_text(face = "plain", size = 15, color = "black"),
        strip.background = element_blank(),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.border = element_blank(),
        panel.spacing=unit(1, "lines"),
        plot.margin = margin(1, 0.3, 1, 0.3, "cm"), 
        legend.title = element_blank(),
        legend.position=c(0.8, 0.85))
# qa1.plot1

qa1.plot2 <- ggplot(data=qa1_allL, aes(x=sn, y=prop)) +
  stat_summary(fun = mean, geom = "bar", position="dodge", fill="gray70",
               na.rm = TRUE, alpha = .9, width = 0.8,  color="black", size = 0.15) +
  geom_hline(yintercept=50, linetype='dashed', color='darkred', alpha =1, size=1) +
  # coord_cartesian(ylim = c(0, 0.3), clip = "on") +
  # coord_cartesian(ylim = c(0, 5), clip = "on") +
  labs(x = "Subject Number", y = "Proportion of Outliers (%)") +
  theme_bw(base_size = 18) +
  theme(axis.title = element_text(face = "bold", size = 16, color = "black"),
        axis.text = element_text(face = "plain", size = 15, color = "black"),
        axis.text.x = element_text(face = "plain", size = 15, color = "black"),
        axis.line=element_line(),
        strip.text.x = element_text(face = "plain", size = 15, color = "black"),
        strip.background = element_blank(),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.border = element_blank(),
        panel.spacing=unit(1, "lines"),
        plot.margin = margin(1, 0.3, 1, 0.3, "cm"), 
        legend.title = element_blank(),
        legend.position=c(0.8, 0.85))
# qa1.plot2

qa1.plot <- ggarrange(qa1.plot1, qa1.plot2, ncol = 2, widths = c(1,3), 
                      labels = c("A", "B"))
qa1.plot


5.3 By Part & Subject, Framewise Displacement


각 참가자별로, 영상의 전/후반부 간 FD 값의 체계적인 차이가 있는지 확인하였다.


# subject-level, long format
qa2_t <- qa1_t %>% dplyr::filter(run != 0, part != 'all', part != 'stim')
qa2_t$part <- factor(qa2_t$part)
qa2_allL <- qa2_t %>% group_by(sn, part) %>%
  dplyr::summarise(fd=mean(fd)) %>%
  ungroup()
## `summarise()` has grouped output by 'sn'. You can override using the `.groups` argument.

# summary table: grand mean
qa2_allG <- qa2_allL %>% group_by(part) %>%
  dplyr::summarise(fd.m = mean(fd), fd.sd = sd(fd)) %>%
  ungroup()
qa2_allG$fd.se <- Rmisc::summarySEwithin(data = qa2_allL, measurevar = "fd", 
                                         idvar = "sn", withinvars = c("part"))$se
qa2_allG$fd.ci <- Rmisc::summarySEwithin(data = qa2_allL, measurevar = "fd", 
                                         idvar = "sn", withinvars = c("part"))$ci
qa2_allG <- qa2_allG %>% 
  mutate(lower.ci = fd.m-fd.ci,
         upper.ci = fd.m+fd.ci,
         lower.se = fd.m-fd.se,
         upper.se = fd.m+fd.se)

qa2_allG %>% kable(digits=3)
part fd.m fd.sd fd.se fd.ci lower.ci upper.ci lower.se upper.se
p1 0.090 0.040 0.002 0.003 0.087 0.093 0.089 0.092
p2 0.086 0.039 0.002 0.003 0.083 0.089 0.085 0.088


qa2.plot2 <- ggplot(data=qa2_allL, aes(x=sn, y=fd, fill=part)) +
  stat_summary(fun = mean, geom = "bar", position="dodge", 
               na.rm = TRUE, alpha = .9, width = 0.8,  color="black", size = 0.15) +
  geom_hline(yintercept=0.2, linetype='dashed', color='darkred', alpha =1, size=1) +
  # coord_cartesian(ylim = c(0, 0.3), clip = "on") +
  # coord_cartesian(ylim = c(0, 5), clip = "on") +
  scale_fill_manual(values = c("#ED7D31", "#5B9BD5"), # c("#ED7D31", "#5B9BD5", "#70AD47"),
                    labels = c("First Half", "Second Half")) +
#  scale_fill_brewer(palette="Set2", labels = c('part 1', 'part 2')) + 
  labs(x = "Subject Number", y = "FD value") +
  theme_bw(base_size = 18) +
  theme(axis.title = element_text(face = "bold", size = 16, color = "black"),
        axis.text = element_text(face = "plain", size = 15, color = "black"),
        axis.text.x = element_text(face = "plain", size = 15, color = "black"),
        axis.line=element_line(),
        strip.text.x = element_text(face = "plain", size = 15, color = "black"),
        strip.background = element_blank(),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.border = element_blank(),
        panel.spacing=unit(1, "lines"),
        plot.margin = margin(1, 0.3, 1, 0.3, "cm"), 
        legend.title = element_blank(),
        legend.position='top')
qa2.plot2

5.4 By Part, Framewise Displacement


영상의 전/후반부에서 FD value의 차이를 요약하였다.


# subject-level, long format
qa2_t <- qa1_t %>% dplyr::filter(run != 0, part != 'all', part != 'stim')
qa2_t$part <- factor(qa2_t$part)
qa2_allL <- qa2_t %>% group_by(sn, part) %>%
  dplyr::summarise(fd=mean(fd)) %>%
  ungroup()
## `summarise()` has grouped output by 'sn'. You can override using the `.groups` argument.

# subject-level, wide format
qa2_allW <- qa2_allL %>% spread(key=part, value = fd)
# qa2_allW %>% kable(digits=2)

# summary table: grand mean
qa2_allG <- qa2_allL %>% group_by(part) %>%
  dplyr::summarise(fd.m = mean(fd), fd.sd = sd(fd)) %>%
  ungroup()
qa2_allG$fd.se <- Rmisc::summarySEwithin(data = qa2_allL, measurevar = "fd", 
                                         idvar = "sn", withinvars = c("part"))$se
qa2_allG$fd.ci <- Rmisc::summarySEwithin(data = qa2_allL, measurevar = "fd", 
                                         idvar = "sn", withinvars = c("part"))$ci
qa2_allG <- qa2_allG %>% 
  mutate(lower.ci = fd.m-fd.ci,
         upper.ci = fd.m+fd.ci,
         lower.se = fd.m-fd.se,
         upper.se = fd.m+fd.se)

qa2_allG %>% kable(digits=3)
part fd.m fd.sd fd.se fd.ci lower.ci upper.ci lower.se upper.se
p1 0.090 0.040 0.002 0.003 0.087 0.093 0.089 0.092
p2 0.086 0.039 0.002 0.003 0.083 0.089 0.085 0.088


library(RColorBrewer)
# display.brewer.all()

qa2_allL.1 <- qa2_allL
qa2_allW.1 <- qa2_allW
qa2_allG.1 <- qa2_allG

qa2.p1.all.plot1 <- ggplot(data=qa2_allL.1, aes(x=part, y=fd, fill=part, shpae=part)) +
  stat_summary(fun = mean, geom = "bar", position="dodge", 
               na.rm = TRUE, alpha = .9, width = 0.8,  size = 0.15, color = "black" ) +
  geom_hline(yintercept=0.2, linetype='dashed', color="gray20", alpha =1, size=1) +
  geom_segment(data=filter(qa2_allW.1), inherit.aes = FALSE,
               aes(x=1, y=filter(qa2_allW.1)$p1,
                   xend=2, yend=filter(qa2_allW.1)$p2),
               color="gray90") +
  geom_point(data=qa2_allL.1, aes(x=part, y=fd, fill=part), position = position_dodge(width=0.8),
             size=2, show.legend=F, color="gray90") +
  
  geom_errorbar(data=qa2_allG.1, aes(x=part, y= fd.m, ymin=fd.m-fd.ci, ymax=fd.m+fd.ci), width=.2,
                position=position_dodge(.8), color = "black") +
  scale_fill_manual(values = c("#ED7D31", "#5B9BD5"), # c("#ED7D31", "#5B9BD5", "#70AD47"),
                    labels = c("First Half", "Second Half")) +
  
#  scale_fill_brewer(palette="Set2",labels = c('part 1', 'part 2')) + 
  # coord_cartesian(ylim = c(0, 100), clip = "on") +
  labs(x = "Part", y = "mean FD value") +
  ggtitle("By Part, Framewise Displacement") +
  theme_bw(base_size = 18) +
  theme(axis.text.x=element_blank(),
        axis.ticks.x=element_blank(),
        axis.title = element_text(face = "bold", size = 16, color = "black"),
        axis.text = element_text(face = "plain", hjust = 0.5, size = 15, color = "black"),
        axis.line=element_line(),
        strip.text.x = element_text(face = "plain", size = 15, color = "black"),
        strip.background = element_blank(),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.border = element_blank(),
        panel.spacing=unit(1, "lines"),
        plot.margin = margin(1, 0.3, 1, 0.3, "cm"), 
        legend.title = element_blank(),
        legend.position="bottom")
# plot-control 3
# ggsave("fig1_1.fmri.jpg", plot = r3.p1.all.plot1, width=6, height=6, unit='in', dpi=600)
qa2.p1.all.plot1


전/후반부 간 FD 값의 차이는 통계적으로 유의하지 않았다.


qa2_allL.1.tmp <- qa2_allL 

qa2.aov1.tmp <- aov_ez(id="sn", dv="fd", data = qa2_allL.1.tmp, within = c("part"))
# summary(r1.aov1)
nice(qa2.aov1.tmp, es="pes") %>% kable(digits=2)
Effect df MSE F pes p.value
part 1, 19 0.00 3.24 + .146 .088
p_h1 <- qa2_allL.1.tmp %>% 
  rstatix::pairwise_t_test(fd ~ part,
                           p.adjust.method="holm",
                           paired=T, detailed=T) %>%
  dplyr::select(group1, group2, estimate, conf.low, conf.high, df, statistic, p.adj, p.adj.signif)
p_h2 <- qa2_allL.1.tmp %>% 
  rstatix::cohens_d(fd ~ part, paired=T, ci = F) %>%
  dplyr::select(group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("group1", "group2")) %>% kable(digits=3)
group1 group2 estimate conf.low conf.high df statistic p.adj p.adj.signif effsize magnitude
p1 p2 0.004 -0.001 0.009 19 1.799 0.088 ns 0.402 small
bh_t <- bh_t %>% filter(sn %in% targ_sn)




6 fMRI Results


이야기 지각 중 획득된 fMRI 뇌 영상 자료는 상기한 자료를 기반으로 전, 후반으로 분할되었고, 각 구획의 자료는 기능적 연결성 패턴(functional connectivity pattern)으로 재구성되었다.


먼저 전체 뇌의 기능적 연결성 패턴 분석을 위한 Whole-brain parcellation은 Yeo et al.2011; Yeo et al., 2015 을 따라 이루어졌다. 먼저 7개 Brain Network(Vis, SM, FPN, DAN, VAN, DMN, Limbic Network)를 기반으로 한 114개의 cortical regions를 MNI space로 변환하였다YeoLab, GitHub. Sub-cortical Regions으로 FSL MNI152 template brain에서 Freesurfer segmentation으로 추출된 8개의 ROIs(bilateral amygdala, hippocampus, thalamus, striatum)을 준비하였다. 이 ROI들은 Subcortical Network로 할당하였다. 이러한 절차를 통해 최종적으로 122개 ROIs, 8개 Network (Vis, SM, FPN, DAN, VAN, DMN, Limbic Network, Subcor) + TemporalParietal이 준비되었다.


fMRI EPI 데이터는 FSL 6.0.4과 FMRIB software libraries (Analysis Group, FMRIB, Oxford, UK; http://fsl.fmrib.ox.ac.uk)로 전처리되었다. 구체적으로 EPI 데이터의 T1 equilibration을 위해 각 scan run에서 3개의 volume(6s)을 제거하고 Slice Timing Correction과 Motion Correction을 수행하였다. 또한 128-s period cut-off의 high-pass filter로 필터링되었다. Spatial smoothing은 5-mm full-width half-maximum (FWHM) kernel로 수행되었다. 이어서 전처리된 fMRI 데이터에서 noise를 제거하기 위해 Nuisance Regression을 수행하였다. Regression에는 6개의 motion-related parameter, 각 parameter의 quadratic term 6개, 그리고 Global Mean Siganl, White-matter Mask와 Ventricle Mask에서 각각 추출된 3개의 regressors, 그리고 전체 parameter들의 temporal derivatives를 포함하여 총 30개의 regressors가 포함되었다. Nuisance regression 후 종적으로 산출된 cleaned fMRI EPI 데이터는 High-resoultion structural scan -> MNI template, EPI -> High-resolution structural scan, EPI -> MNI temlate의 과정을 통해 Registration 되었다.


결과적으로 생성된 standard MNI brain 데이터에서 각 영상의 timepoint별로 timecourse data를 추출하였다. 추출된 영상 별 timecourse data는 사전에 설정된 전/후반부로 분할되었다. 구획별 fMRI 신호의 겹침을 방지하고, 정확한 timecourse data를 추출하기 위해, 영상의 시작 부분 3TR, 영상의 전/후반부 경계의 전후의 3TR (6TR)을 제거하고, 전/후반부의 timecourse data를 추출하였다. 추출된 timecourse data는 사전에 준비된 122개 ROI에 따라 추출 및 평균화 되었다. 이에 따라 총 122개의 Timecourse가 전/후반부 별로 총 30개 영상에 대해 준비되었다.


30개 영상, 전/후반부의 122개 timecourse에서 기능적 연결성 분석을 수행하였다. 각 영상의 구획별 122개 timecourse에서 서로 간 Pearson correlation을 계산하여 122 x 122의 Connectivity Matrix를 구성하고, Fisher의 z-transformation을 통해 각 r값을 z 값으로 변환하였다. 이어서 각 matrix에서 edge들을 추출하여 영상/구획별 connectivity pattern을 추출하고 edge들에 8개 networ k + TP와 Between Network의 인덱스를 부여하였다. 이러한 과정을 통해 전체 참가자별로, 30개의 영상에 대한 전/후반후 connectivity pattern 데이터가 준비되었다.


최종 connectivity pattern에 대하여 Multivariate Pattern Analysis를 수행하였다. 이 분석은 성실히 보지 않았거나, 제대로 이해하지 못한 것으로 판정된 영상들을 제외한 나머지 영상의 패턴들을 대상으로 수행되었다. 먼저 Python 분석(aniFC_sFC_analysis.ipynb 코드 참조)을 수행하였다. Python을 활용한 분석에는 numpy, pandas, sklearn, brain connectivity toolbox 등의 package가 사용되었다. 참가자 내에서 영상별 분류가 패턴 분류가 되는지, 참가자 간에 걸쳐 패턴 분류가 되는지 확인하기 위해 Machine learning 기법으로 패턴 분류를 수행하였다. 추가로, BCT 패키지를 통해Network Analysis를 수행하여 조건/패턴별 network measure를 추출하였다. 이어서 Matlab을 통해 Representational Similarity Analysis를 수행하였다. 각 참가자 내에서 영상 내/간의 패턴 유사성을 비교하고 전체 영상에서 전/후반부 별 패턴 유사성을 비교하였다. 아래에는 위 분석에 대한 통계 분석을 수행한다.



6.1 MVPC - Classifier Check


먼저 Python 코드를 활용한 Multivariate Pattern Classification 결과를 확인한다. 첫째로 참가자 내에서 서로 다른 영상에 대하여 전/후반부에 따른 패턴 분류가 성공적으로 되는지 살펴보았다. 참가자 내 패턴 분류는 Run을 기준으로 Train & Test 셋을 구성하여 수행하였다. 구체적으로 10개 Run 중 9개 (27개 영상)를 Training Set, 1개 Run(3개 영상)을 Test Set으로 구분하고, Training & Test를 수행한다. 이 과정을 Cross-Validation Step 과 유사하게 Run 별로 10번 반복하여 10번의 정확도를 평균화하였다.분석 모델에 따른 차이를 확인하기 위해서 Ridge, Logistic Regression, SVM의 세 가지 classifier 모델을 활용하였다.


r5 <- read.csv("py_output/sFC_mvpc_subj_opt3_std2.csv", header = T)

glimpse(r5, width = 70)
## Rows: 600
## Columns: 7
## $ subj       <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1…
## $ net        <int> 10, 10, 10, 0, 0, 0, 1, 1, 1, 2, 2, 2, 3, 3, 3, 4…
## $ classifier <int> 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2…
## $ valid_acc  <dbl> 84, 84, 84, 84, 84, 84, 70, 72, 70, 58, 56, 58, 7…
## $ p1_acc     <dbl> 80, 80, 80, 80, 84, 84, 64, 64, 68, 52, 48, 60, 7…
## $ p2_acc     <dbl> 88, 88, 88, 88, 84, 84, 76, 80, 72, 64, 64, 56, 6…
## $ auc        <dbl> 84, 84, 84, 84, 84, 84, 70, 72, 70, 58, 56, 58, 7…

r5_l <- r5 %>% filter(subj %in% targ_sn)
r5_l$sn = factor(r5_l$subj)
r5_l$netNum = factor(r5_l$net, 
                     levels = c(10, 0, 1, 2, 3, 4, 5, 6, 7, 9),
                     labels = c('All', 'Btw', 'Vis', 'SM', 'FPN',
                                'VAN', 'DAN', 'DMN', 'Limb', 'SubCor'))

# % 0. All
# % 1. Vis
# % 2. SM
# % 3. FPN
# % 4. VAN
# % 5. DAN
# % 6. DMN
# % 7. Limbic
# % 8. TP
# % 9. SubCor
# % 10. BTW

r5_l$classf = factor(r5_l$classifier, levels=c(1,2,3),
                     labels = c('ridge', 'logreg', 'linearSVM'))
r5_l$acc = r5_l$valid_acc


r5_1 = r5_l %>% dplyr::select(sn, netNum, classf, acc, p1_acc, p2_acc,
                              auc)

table(r5_1$sn, r5_1$netNum)
##     
##      All Btw Vis SM FPN VAN DAN DMN Limb SubCor
##   1    3   3   3  3   3   3   3   3    3      3
##   2    3   3   3  3   3   3   3   3    3      3
##   3    3   3   3  3   3   3   3   3    3      3
##   4    3   3   3  3   3   3   3   3    3      3
##   5    3   3   3  3   3   3   3   3    3      3
##   6    3   3   3  3   3   3   3   3    3      3
##   7    3   3   3  3   3   3   3   3    3      3
##   8    3   3   3  3   3   3   3   3    3      3
##   9    3   3   3  3   3   3   3   3    3      3
##   10   3   3   3  3   3   3   3   3    3      3
##   11   3   3   3  3   3   3   3   3    3      3
##   13   3   3   3  3   3   3   3   3    3      3
##   14   3   3   3  3   3   3   3   3    3      3
##   15   3   3   3  3   3   3   3   3    3      3
##   16   3   3   3  3   3   3   3   3    3      3
##   17   3   3   3  3   3   3   3   3    3      3
##   18   3   3   3  3   3   3   3   3    3      3
##   19   3   3   3  3   3   3   3   3    3      3
##   20   3   3   3  3   3   3   3   3    3      3
##   21   3   3   3  3   3   3   3   3    3      3


6.1.1 Three Classifier & Network - Accuracy


세 Classifier가 참가자 내에서 영상 간의 패턴 분류를 수행한 결과를 전체 pattern과 네트워크 별 pattern으로 요약하였다.


# glimpse(r5_1)
# subject-level, long format
r5_allL <- r5_1 %>% group_by(sn, classf, netNum) %>%
  dplyr::summarise(acc=mean(acc)) %>%
  ungroup()
## `summarise()` has grouped output by 'sn', 'classf'. You can override using the `.groups` argument.
# r5_allL %>% kable(digits=2)



# subject-level, wide format
r5_allW <- r5_allL %>% spread(key=netNum, value = acc)
# r5_allL %>% filter(sn==2)%>% spread(key=netNum, value = acc)
r5_allW %>% dplyr::select(sn, classf, All) %>% 
  spread(key=sn, value= All)%>% kable(digits=2)
classf 1 2 3 4 5 6 7 8 9 10 11 13 14 15 16 17 18 19 20 21
ridge 84 89.66 88.33 64.58 67.24 84.48 77.59 89.66 77.59 83.33 69.64 72.22 88.33 69.23 72 79.63 82.14 75.93 80.77 73.21
logreg 84 86.21 90.00 64.58 70.69 84.48 77.59 87.93 81.03 83.33 73.21 70.37 86.67 67.31 74 79.63 82.14 77.78 80.77 69.64
linearSVM 84 91.38 88.33 64.58 67.24 84.48 77.59 87.93 77.59 81.48 69.64 72.22 86.67 67.31 72 79.63 82.14 75.93 82.69 71.43
# summary table: grand mean
r5_allG <- r5_allL %>% group_by(classf, netNum) %>%
  dplyr::summarise(acc.m = mean(acc), acc.sd = sd(acc)) %>%
  ungroup()
## `summarise()` has grouped output by 'classf'. You can override using the `.groups` argument.
r5_allG$acc.se <- Rmisc::summarySEwithin(data = r5_allL, measurevar = "acc", 
                                         idvar = "sn", withinvars = c("classf","netNum"))$se
r5_allG$acc.ci <- Rmisc::summarySEwithin(data = r5_allL, measurevar = "acc", 
                                         idvar = "sn", withinvars = c("classf","netNum"))$ci
r5_allG <- r5_allG %>% 
  mutate(lower.ci = acc.m-acc.ci,
         upper.ci = acc.m+acc.ci,
         lower.se = acc.m-acc.se,
         upper.se = acc.m+acc.se)

r5_allG %>% dplyr::select(netNum, classf, acc.m) %>%
  spread(key=netNum, value=acc.m) %>% kable(digits=2)
classf All Btw Vis SM FPN VAN DAN DMN Limb SubCor
ridge 78.48 76.96 71.88 54.65 71.52 61.07 65.50 67.45 52.59 55.76
logreg 78.57 77.94 72.90 54.82 71.88 62.03 67.38 68.44 53.64 56.15
linearSVM 78.21 77.05 68.24 53.45 71.68 60.94 66.38 66.63 53.03 53.99


library(RColorBrewer)
# display.brewer.all()


r5_allL.1 <- r5_allL #%>% filter(netNum == 'All')
r5_allG.1 <- r5_allG #%>% filter(netNum == 'All')
# r5_allG.1 <- r5_allW %>% filter(netNum == 'All')
r5.p1.all.plot1 <- ggplot(data=r5_allL.1, aes(x=netNum, y=acc, fill=netNum, shpae=netNum)) +
  stat_summary(fun = mean, geom = "bar", position="dodge", 
               na.rm = TRUE, alpha = .9, width = 0.8,  size = 0.15, color = "black") +
  geom_hline(yintercept=50, linetype='dashed', color="gray20", alpha =1, size=1) +
  facet_grid(.~classf, scales="free_x", space = "free",
             labeller = labeller(classf = c("ridge" = "ridge",
                                            "logreg" = "logreg",
                                            "linearSVM" = "linear\nSVM",
                                            "rbfSVM" = "rbf\nSVM"))) +
  # geom_dotplot(binaxis = "y", stackdir = "center", stackratio = 0.5,
  #              color = "black", alpha = 0.5, #position = "nudge",
  #              position = position_jitter(0.15),
  #              inherit.aes = TRUE, binwidth = 0.4) +
  # geom_jitter(aes(x=cond, y=z, fill=cond,color = cond), 
  #             position=position_jitter(0.1), cex=2
  #             ) + 
  geom_point(data=r5_allL.1, aes(x=netNum, y=acc, fill=netNum), position = position_dodge(width=0.8),
             size=2, show.legend=F, color="gray90") +
  geom_errorbar(data=r5_allG.1, aes(x=netNum, y= acc.m, ymin=acc.m-acc.ci, ymax=acc.m+acc.ci), width=.2,
                position=position_dodge(.8), color = "black") +
  scale_fill_brewer(palette="Set3") + 
  coord_cartesian(ylim = c(0, 100), clip = "on") +
  labs(x = "Network", y = "Classification Accuracy") +
  ggtitle("FC - Yeo122net MVPC") +
  theme_bw(base_size = 18) +
  theme(axis.text.x=element_blank(),
        axis.ticks.x=element_blank(),
        axis.title = element_text(face = "bold", size = 16, color = "black"),
        axis.text = element_text(face = "plain", hjust = 0.5, size = 15, color = "black"),
        axis.line=element_line(),
        strip.text.x = element_text(face = "plain", size = 15, color = "black"),
        strip.background = element_blank(),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.border = element_blank(),
        panel.spacing=unit(1, "lines"),
        plot.margin = margin(1, 0.3, 1, 0.3, "cm"), 
        legend.title = element_blank(),
        legend.position="bottom")
# plot-control 3
# ggsave("fig1_1.fmri.jpg", plot = r3.p1.all.plot1, width=6, height=6, unit='in', dpi=600)
r5.p1.all.plot1


세 가지 Classifier, Network 별로 정확도가 Chance level인 50%보다 유의하게 높은지 살펴보았다.



r5_allL.1.tmp <- r5_allL 
r5_allL.1.tmp$classf #<- factor(r5_allL.1.tmp$classf, 
##   [1] ridge     ridge     ridge     ridge     ridge     ridge     ridge    
##   [8] ridge     ridge     ridge     logreg    logreg    logreg    logreg   
##  [15] logreg    logreg    logreg    logreg    logreg    logreg    linearSVM
##  [22] linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM
##  [29] linearSVM linearSVM ridge     ridge     ridge     ridge     ridge    
##  [36] ridge     ridge     ridge     ridge     ridge     logreg    logreg   
##  [43] logreg    logreg    logreg    logreg    logreg    logreg    logreg   
##  [50] logreg    linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM
##  [57] linearSVM linearSVM linearSVM linearSVM ridge     ridge     ridge    
##  [64] ridge     ridge     ridge     ridge     ridge     ridge     ridge    
##  [71] logreg    logreg    logreg    logreg    logreg    logreg    logreg   
##  [78] logreg    logreg    logreg    linearSVM linearSVM linearSVM linearSVM
##  [85] linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM ridge    
##  [92] ridge     ridge     ridge     ridge     ridge     ridge     ridge    
##  [99] ridge     ridge     logreg    logreg    logreg    logreg    logreg   
## [106] logreg    logreg    logreg    logreg    logreg    linearSVM linearSVM
## [113] linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM
## [120] linearSVM ridge     ridge     ridge     ridge     ridge     ridge    
## [127] ridge     ridge     ridge     ridge     logreg    logreg    logreg   
## [134] logreg    logreg    logreg    logreg    logreg    logreg    logreg   
## [141] linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM
## [148] linearSVM linearSVM linearSVM ridge     ridge     ridge     ridge    
## [155] ridge     ridge     ridge     ridge     ridge     ridge     logreg   
## [162] logreg    logreg    logreg    logreg    logreg    logreg    logreg   
## [169] logreg    logreg    linearSVM linearSVM linearSVM linearSVM linearSVM
## [176] linearSVM linearSVM linearSVM linearSVM linearSVM ridge     ridge    
## [183] ridge     ridge     ridge     ridge     ridge     ridge     ridge    
## [190] ridge     logreg    logreg    logreg    logreg    logreg    logreg   
## [197] logreg    logreg    logreg    logreg    linearSVM linearSVM linearSVM
## [204] linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM
## [211] ridge     ridge     ridge     ridge     ridge     ridge     ridge    
## [218] ridge     ridge     ridge     logreg    logreg    logreg    logreg   
## [225] logreg    logreg    logreg    logreg    logreg    logreg    linearSVM
## [232] linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM
## [239] linearSVM linearSVM ridge     ridge     ridge     ridge     ridge    
## [246] ridge     ridge     ridge     ridge     ridge     logreg    logreg   
## [253] logreg    logreg    logreg    logreg    logreg    logreg    logreg   
## [260] logreg    linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM
## [267] linearSVM linearSVM linearSVM linearSVM ridge     ridge     ridge    
## [274] ridge     ridge     ridge     ridge     ridge     ridge     ridge    
## [281] logreg    logreg    logreg    logreg    logreg    logreg    logreg   
## [288] logreg    logreg    logreg    linearSVM linearSVM linearSVM linearSVM
## [295] linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM ridge    
## [302] ridge     ridge     ridge     ridge     ridge     ridge     ridge    
## [309] ridge     ridge     logreg    logreg    logreg    logreg    logreg   
## [316] logreg    logreg    logreg    logreg    logreg    linearSVM linearSVM
## [323] linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM
## [330] linearSVM ridge     ridge     ridge     ridge     ridge     ridge    
## [337] ridge     ridge     ridge     ridge     logreg    logreg    logreg   
## [344] logreg    logreg    logreg    logreg    logreg    logreg    logreg   
## [351] linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM
## [358] linearSVM linearSVM linearSVM ridge     ridge     ridge     ridge    
## [365] ridge     ridge     ridge     ridge     ridge     ridge     logreg   
## [372] logreg    logreg    logreg    logreg    logreg    logreg    logreg   
## [379] logreg    logreg    linearSVM linearSVM linearSVM linearSVM linearSVM
## [386] linearSVM linearSVM linearSVM linearSVM linearSVM ridge     ridge    
## [393] ridge     ridge     ridge     ridge     ridge     ridge     ridge    
## [400] ridge     logreg    logreg    logreg    logreg    logreg    logreg   
## [407] logreg    logreg    logreg    logreg    linearSVM linearSVM linearSVM
## [414] linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM
## [421] ridge     ridge     ridge     ridge     ridge     ridge     ridge    
## [428] ridge     ridge     ridge     logreg    logreg    logreg    logreg   
## [435] logreg    logreg    logreg    logreg    logreg    logreg    linearSVM
## [442] linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM
## [449] linearSVM linearSVM ridge     ridge     ridge     ridge     ridge    
## [456] ridge     ridge     ridge     ridge     ridge     logreg    logreg   
## [463] logreg    logreg    logreg    logreg    logreg    logreg    logreg   
## [470] logreg    linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM
## [477] linearSVM linearSVM linearSVM linearSVM ridge     ridge     ridge    
## [484] ridge     ridge     ridge     ridge     ridge     ridge     ridge    
## [491] logreg    logreg    logreg    logreg    logreg    logreg    logreg   
## [498] logreg    logreg    logreg    linearSVM linearSVM linearSVM linearSVM
## [505] linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM ridge    
## [512] ridge     ridge     ridge     ridge     ridge     ridge     ridge    
## [519] ridge     ridge     logreg    logreg    logreg    logreg    logreg   
## [526] logreg    logreg    logreg    logreg    logreg    linearSVM linearSVM
## [533] linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM
## [540] linearSVM ridge     ridge     ridge     ridge     ridge     ridge    
## [547] ridge     ridge     ridge     ridge     logreg    logreg    logreg   
## [554] logreg    logreg    logreg    logreg    logreg    logreg    logreg   
## [561] linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM
## [568] linearSVM linearSVM linearSVM ridge     ridge     ridge     ridge    
## [575] ridge     ridge     ridge     ridge     ridge     ridge     logreg   
## [582] logreg    logreg    logreg    logreg    logreg    logreg    logreg   
## [589] logreg    logreg    linearSVM linearSVM linearSVM linearSVM linearSVM
## [596] linearSVM linearSVM linearSVM linearSVM linearSVM
## Levels: ridge logreg linearSVM
                               #levels = c("ridge", "logreg", "linearSVM"))
r5_allL.1.tmp$netNum #<- factor(r5_allL.1.tmp$netNum, 
##   [1] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
##  [11] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
##  [21] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
##  [31] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
##  [41] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
##  [51] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
##  [61] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
##  [71] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
##  [81] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
##  [91] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
## [101] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
## [111] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
## [121] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
## [131] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
## [141] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
## [151] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
## [161] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
## [171] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
## [181] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
## [191] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
## [201] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
## [211] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
## [221] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
## [231] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
## [241] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
## [251] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
## [261] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
## [271] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
## [281] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
## [291] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
## [301] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
## [311] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
## [321] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
## [331] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
## [341] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
## [351] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
## [361] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
## [371] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
## [381] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
## [391] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
## [401] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
## [411] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
## [421] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
## [431] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
## [441] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
## [451] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
## [461] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
## [471] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
## [481] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
## [491] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
## [501] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
## [511] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
## [521] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
## [531] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
## [541] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
## [551] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
## [561] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
## [571] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
## [581] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
## [591] All    Btw    Vis    SM     FPN    VAN    DAN    DMN    Limb   SubCor
## Levels: All Btw Vis SM FPN VAN DAN DMN Limb SubCor
                               #levels = c("All", "Vis", "SM", "Control", "salvAtt", "DAN", "DMN", "Limb", "SubCor"))
p_h1 <- r5_allL.1.tmp %>% group_by(classf, netNum) %>% 
  rstatix::t_test(acc ~ 1, mu = 50,
                  detailed=T) %>%
  dplyr::select(classf, netNum, group1, group2, estimate, conf.low, conf.high, df, statistic, p)
p_h2 <- r5_allL.1.tmp %>% group_by(classf, netNum) %>% 
  rstatix::cohens_d(acc ~ 1, mu = 50, ci = F) %>%
  dplyr::select(classf, netNum, group1, group2, effsize, magnitude)
Res <-  merge(p_h1, p_h2, by=c("classf", "netNum", "group1", "group2")) 
as_tibble(Res[c(order(Res$classf, Res$netNum) ),]) %>% 
  dplyr::select(classf, netNum, group2, estimate, conf.low, conf.high, df, statistic, p ,effsize, magnitude) %>% kable(digits =3)
classf netNum group2 estimate conf.low conf.high df statistic p effsize magnitude
ridge All null model 78.478 74.831 82.126 19 16.342 0.000 3.654 large
ridge Btw null model 76.956 73.631 80.281 19 16.968 0.000 3.794 large
ridge Vis null model 71.878 67.788 75.967 19 11.197 0.000 2.504 large
ridge SM null model 54.653 50.390 58.916 19 2.285 0.034 0.511 moderate
ridge FPN null model 71.522 66.551 76.493 19 9.061 0.000 2.026 large
ridge VAN null model 61.067 57.295 64.838 19 6.141 0.000 1.373 large
ridge DAN null model 65.498 62.517 68.478 19 10.881 0.000 2.433 large
ridge DMN null model 67.451 64.355 70.548 19 11.796 0.000 2.638 large
ridge Limb null model 52.594 48.702 56.486 19 1.395 0.179 0.312 small
ridge SubCor null model 55.756 52.436 59.075 19 3.629 0.002 0.812 large
logreg All null model 78.568 75.111 82.026 19 17.296 0.000 3.867 large
logreg Btw null model 77.943 74.592 81.293 19 17.458 0.000 3.904 large
logreg Vis null model 72.900 68.882 76.917 19 11.930 0.000 2.668 large
logreg SM null model 54.819 50.495 59.143 19 2.332 0.031 0.522 moderate
logreg FPN null model 71.885 66.687 77.082 19 8.813 0.000 1.971 large
logreg VAN null model 62.030 57.900 66.161 19 6.096 0.000 1.363 large
logreg DAN null model 67.383 63.959 70.806 19 10.627 0.000 2.376 large
logreg DMN null model 68.442 65.090 71.793 19 11.517 0.000 2.575 large
logreg Limb null model 53.644 50.177 57.112 19 2.200 0.040 0.492 small
logreg SubCor null model 56.151 52.744 59.557 19 3.779 0.001 0.845 large
linearSVM All null model 78.213 74.513 81.914 19 15.958 0.000 3.568 large
linearSVM Btw null model 77.053 73.808 80.297 19 17.453 0.000 3.903 large
linearSVM Vis null model 68.242 63.757 72.727 19 8.512 0.000 1.903 large
linearSVM SM null model 53.455 50.146 56.763 19 2.186 0.042 0.489 small
linearSVM FPN null model 71.678 66.634 76.722 19 8.995 0.000 2.011 large
linearSVM VAN null model 60.943 57.132 64.754 19 6.010 0.000 1.344 large
linearSVM DAN null model 66.381 63.265 69.496 19 11.004 0.000 2.461 large
linearSVM DMN null model 66.635 63.285 69.984 19 10.395 0.000 2.324 large
linearSVM Limb null model 53.028 49.923 56.132 19 2.041 0.055 0.456 small
linearSVM SubCor null model 53.990 49.787 58.194 19 1.987 0.062 0.444 small


세 가지 Classifier에 따른 전반적인 정확도 차이가 있는지 살펴보았다.



r5_allL.1.tmp <- r5_allL %>% filter(netNum == "All")
r5.aov1.tmp <- aov_ez(id="sn", dv="acc", data = r5_allL.1.tmp, within = c("classf"))
# summary(r1.aov1)
nice(r5.aov1.tmp, es="pes") %>% kable(digits=2)
Effect df MSE F pes p.value
classf 1.39, 26.38 2.40 0.41 .021 .595

r5_allL.1.tmp <- r5_allL %>% filter(classf == "ridge")
r5.aov1.tmp <- aov_ez(id="sn", dv="acc", data = r5_allL.1.tmp, within = c("netNum"))
# summary(r1.aov1)
nice(r5.aov1.tmp, es="pes") %>% kable(digits=2)
Effect df MSE F pes p.value
netNum 5.29, 100.60 67.50 43.60 *** .697 <.001

p_h1 <- r5_allL.1.tmp %>% group_by(classf) %>%
  rstatix::pairwise_t_test(acc ~ netNum,
                           p.adjust.method="holm",
                           paired=T, detailed=T) %>%
  dplyr::select(classf, group1, group2, estimate, conf.low, conf.high, df, statistic, p.adj, p.adj.signif)
p_h2 <- r5_allL.1.tmp %>% group_by(classf) %>%
  rstatix::cohens_d(acc ~ netNum, paired=T, ci = F) %>%
  dplyr::select(classf, group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("classf","group1", "group2")) %>% kable(digits = 3)
classf group1 group2 estimate conf.low conf.high df statistic p.adj p.adj.signif effsize magnitude
ridge All Btw 1.522 0.418 2.626 19 2.886 0.114 ns 0.645 moderate
ridge All DAN 12.981 10.100 15.861 19 9.432 0.000 **** 2.109 large
ridge All DMN 11.027 7.659 14.395 19 6.853 0.000 **** 1.532 large
ridge All FPN 6.957 3.397 10.516 19 4.091 0.012 * 0.915 large
ridge All Limb 25.884 21.649 30.119 19 12.793 0.000 **** 2.861 large
ridge All SM 23.825 20.220 27.430 19 13.833 0.000 **** 3.093 large
ridge All SubCor 22.723 19.140 26.305 19 13.275 0.000 **** 2.968 large
ridge All VAN 17.412 12.837 21.987 19 7.966 0.000 **** 1.781 large
ridge All Vis 6.601 2.509 10.692 19 3.377 0.054 ns 0.755 moderate
ridge Btw DAN 11.459 8.370 14.548 19 7.764 0.000 **** 1.736 large
ridge Btw DMN 9.505 6.278 12.732 19 6.166 0.000 *** 1.379 large
ridge Btw FPN 5.435 1.574 9.295 19 2.946 0.112 ns 0.659 moderate
ridge Btw Limb 24.362 20.245 28.479 19 12.385 0.000 **** 2.769 large
ridge Btw SM 22.303 18.820 25.787 19 13.401 0.000 **** 2.996 large
ridge Btw SubCor 21.201 17.885 24.517 19 13.381 0.000 **** 2.992 large
ridge Btw VAN 15.890 11.637 20.143 19 7.820 0.000 **** 1.749 large
ridge Btw Vis 5.079 1.279 8.879 19 2.797 0.126 ns 0.626 moderate
ridge DAN DMN -1.954 -5.777 1.870 19 -1.070 1.000 ns -0.239 small
ridge DAN Limb 12.903 7.762 18.045 19 5.253 0.001 *** 1.175 large
ridge DAN SubCor 9.742 6.066 13.417 19 5.547 0.001 *** 1.240 large
ridge DMN Limb 14.857 10.900 18.814 19 7.858 0.000 **** 1.757 large
ridge DMN SubCor 11.696 8.528 14.863 19 7.728 0.000 **** 1.728 large
ridge FPN DAN 6.024 0.936 11.113 19 2.478 0.228 ns 0.554 moderate
ridge FPN DMN 4.070 -0.040 8.181 19 2.073 0.365 ns 0.463 small
ridge FPN Limb 18.928 14.530 23.326 19 9.008 0.000 **** 2.014 large
ridge FPN SubCor 15.766 11.322 20.210 19 7.425 0.000 **** 1.660 large
ridge FPN VAN 10.455 6.007 14.903 19 4.920 0.002 ** 1.100 large
ridge Limb SubCor -3.162 -7.317 0.994 19 -1.592 0.640 ns -0.356 small
ridge SM DAN -10.844 -14.726 -6.963 19 -5.847 0.000 *** -1.307 large
ridge SM DMN -12.798 -15.708 -9.888 19 -9.205 0.000 **** -2.058 large
ridge SM FPN -16.869 -20.950 -12.787 19 -8.651 0.000 **** -1.934 large
ridge SM Limb 2.059 -3.013 7.131 19 0.850 1.000 ns 0.190 negligible
ridge SM SubCor -1.103 -4.560 2.355 19 -0.667 1.000 ns -0.149 negligible
ridge SM VAN -6.413 -10.945 -1.881 19 -2.962 0.112 ns -0.662 moderate
ridge VAN DAN -4.431 -9.096 0.234 19 -1.988 0.368 ns -0.445 small
ridge VAN DMN -6.385 -10.561 -2.209 19 -3.200 0.075 ns -0.716 moderate
ridge VAN Limb 8.472 4.398 12.547 19 4.352 0.007 ** 0.973 large
ridge VAN SubCor 5.311 0.686 9.935 19 2.404 0.239 ns 0.537 moderate
ridge Vis DAN 6.380 1.964 10.796 19 3.024 0.105 ns 0.676 moderate
ridge Vis DMN 4.426 0.243 8.610 19 2.215 0.314 ns 0.495 small
ridge Vis FPN 0.356 -5.314 6.026 19 0.131 1.000 ns 0.029 negligible
ridge Vis Limb 19.283 13.507 25.060 19 6.987 0.000 **** 1.562 large
ridge Vis SM 17.224 12.128 22.320 19 7.074 0.000 **** 1.582 large
ridge Vis SubCor 16.122 12.012 20.231 19 8.211 0.000 **** 1.836 large
ridge Vis VAN 10.811 4.469 17.153 19 3.568 0.037 * 0.798 moderate


결과적으로 세 가지 Classifier 간의 강한 차이는 관찰되지 않았다. 따라서 아래에서는 Ridge Classifier를 사용하여 분석한 결과를 확인한다.


6.1.2 Ridge & Network & Part - Accuracy


ridge classifier, 네트워크 별로 파트 간 정확도 차이가 있는지 살펴본다.



# subject-level, long format
r5_11 <- r5_1 %>% dplyr::filter(classf == "ridge") %>% #"ridge") %>% rbfSVM
  dplyr::select(sn, netNum, classf, p1_acc, p2_acc)
r5_11 <- gather(r5_11, key = part, value = acc, p1_acc:p2_acc)
r5_11$part <- factor(r5_11$part,
                     levels = c('p1_acc', 'p2_acc'),
                     labels = c('p1', 'p2'))

r5_allL <- r5_11 %>% group_by(sn, classf, netNum, part) %>%
  dplyr::summarise(acc=mean(acc)) %>%
  ungroup()
## `summarise()` has grouped output by 'sn', 'classf', 'netNum'. You can override using the `.groups` argument.
# r5_allL %>% kable(digits=2)

# subject-level, wide format
r5_allW <- r5_allL %>% spread(key=netNum, value = acc)
# r5_allL %>% filter(sn==2)%>% spread(key=netNum, value = acc)
r5_allW %>% dplyr::select(sn, classf, part, All) %>% 
  spread(key=part, value= All)%>% kable(digits=2)
sn classf p1 p2
1 ridge 80.00 88.00
2 ridge 82.76 96.55
3 ridge 86.67 90.00
4 ridge 58.33 70.83
5 ridge 65.52 68.97
6 ridge 75.86 93.10
7 ridge 72.41 82.76
8 ridge 79.31 100.00
9 ridge 79.31 75.86
10 ridge 81.48 85.19
11 ridge 67.86 71.43
13 ridge 66.67 77.78
14 ridge 83.33 93.33
15 ridge 57.69 80.77
16 ridge 68.00 76.00
17 ridge 77.78 81.48
18 ridge 67.86 96.43
19 ridge 70.37 81.48
20 ridge 69.23 92.31
21 ridge 71.43 75.00
# summary table: grand mean
r5_allG <- r5_allL %>% group_by(classf, netNum, part) %>%
  dplyr::summarise(acc.m = mean(acc), acc.sd = sd(acc)) %>%
  ungroup()
## `summarise()` has grouped output by 'classf', 'netNum'. You can override using the `.groups` argument.
r5_allG$acc.se <- Rmisc::summarySEwithin(data = r5_allL, measurevar = "acc", 
                                         idvar = "sn", withinvars = c("classf","netNum","part"))$se
r5_allG$acc.ci <- Rmisc::summarySEwithin(data = r5_allL, measurevar = "acc", 
                                         idvar = "sn", withinvars = c("classf","netNum","part"))$ci
r5_allG <- r5_allG %>% 
  mutate(lower.ci = acc.m-acc.ci,
         upper.ci = acc.m+acc.ci,
         lower.se = acc.m-acc.se,
         upper.se = acc.m+acc.se)

r5_allG %>% dplyr::select(netNum, classf, part, acc.m, acc.sd) %>% kable(digits=2)
netNum classf part acc.m acc.sd
All ridge p1 73.09 8.17
All ridge p2 83.86 9.44
Btw ridge p1 70.62 7.93
Btw ridge p2 83.29 8.81
Vis ridge p1 69.45 9.09
Vis ridge p2 74.31 10.55
SM ridge p1 53.28 10.14
SM ridge p2 56.02 9.89
FPN ridge p1 69.51 10.07
FPN ridge p2 73.54 12.81
VAN ridge p1 56.47 8.28
VAN ridge p2 65.66 10.98
DAN ridge p1 61.98 9.72
DAN ridge p2 69.02 6.68
DMN ridge p1 63.97 7.54
DMN ridge p2 70.93 7.29
Limb ridge p1 51.36 10.89
Limb ridge p2 53.82 8.45
SubCor ridge p1 54.23 10.21
SubCor ridge p2 57.28 9.19
# %>% spread(key=part, value=acc.m) 
library(RColorBrewer)
# display.brewer.all()


r5_allL.1 <- r5_allL #%>% filter(netNum == 'All')
r5_allG.1 <- r5_allG #%>% filter(netNum == 'All')
# r5_allG.1 <- r5_allW %>% filter(netNum == 'All')
r5.p1.all.plot1 <- ggplot(data=r5_allL.1, aes(x=part, y=acc, fill=part, shpae=part)) +
  stat_summary(fun = mean, geom = "bar", position="dodge", 
               na.rm = TRUE, alpha = .9, width = 0.8,  size = 0.15, color = "black" ) +
  geom_hline(yintercept=50, linetype='dashed', color="gray20", alpha =1, size=1) +
  facet_grid(.~netNum, scales="free_x", space = "free") +
  # geom_dotplot(binaxis = "y", stackdir = "center", stackratio = 0.5,
  #              color = "black", alpha = 0.5, #position = "nudge",
  #              position = position_jitter(0.15),
  #              inherit.aes = TRUE, binwidth = 0.4) +
  # geom_jitter(aes(x=cond, y=z, fill=cond,color = cond), 
  #             position=position_jitter(0.1), cex=2
  #             ) + 
  geom_point(data=r5_allL.1, aes(x=part, y=acc, fill=part), position = position_dodge(width=0.8),
             size=2, show.legend=F, color="gray90") +
  geom_errorbar(data=r5_allG.1, aes(x=part, y= acc.m, ymin=acc.m-acc.ci, ymax=acc.m+acc.ci), width=.2,
                position=position_dodge(.8), color = "black") +
  scale_fill_manual(values = c("#ED7D31", "#5B9BD5"), # c("#ED7D31", "#5B9BD5", "#70AD47"),
                    labels = c("First Half", "Second Half")) +
  coord_cartesian(ylim = c(0, 100), clip = "on") +
  labs(x = "Part", y = "Classification Accuracy") +
  ggtitle("FC - Yeo122net Ridge MVPC") +
  theme_bw(base_size = 18) +
  theme(axis.text.x=element_blank(),
        axis.ticks.x=element_blank(),
        axis.title = element_text(face = "bold", size = 16, color = "black"),
        axis.text = element_text(face = "plain", hjust = 0.5, size = 15, color = "black"),
        axis.line=element_line(),
        strip.text.x = element_text(face = "plain", size = 15, color = "black"),
        strip.background = element_blank(),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.border = element_blank(),
        panel.spacing=unit(1, "lines"),
        plot.margin = margin(1, 0.3, 1, 0.3, "cm"), 
        legend.title = element_blank(),
        legend.position="bottom")
# plot-control 3
# ggsave("fig1_1.fmri.jpg", plot = r3.p1.all.plot1, width=6, height=6, unit='in', dpi=600)
r5.p1.all.plot1


각 파트별 정확도가 Chance level 인 50% 보다 유의하게 높은지 살펴본다.



r5_allL.1.tmp <- r5_allL 
p_h1 <- r5_allL.1.tmp %>% group_by(classf, netNum, part) %>% 
  rstatix::t_test(acc ~ 1, mu = 50,
                  detailed=T) %>%
  dplyr::select(classf, netNum, part, group1, group2, estimate, conf.low, conf.high, df, statistic, p)
p_h2 <- r5_allL.1.tmp %>% group_by(classf, netNum, part) %>% 
  rstatix::cohens_d(acc ~ 1, mu = 50, ci = F) %>%
  dplyr::select(classf, netNum, part, group1, group2, effsize, magnitude)
Res <-  merge(p_h1, p_h2, by=c("classf", "netNum", "part", "group1", "group2")) 
Res[c(order(Res$classf, Res$netNum, Res$part) ),] %>% kable(digits =3)
classf netNum part group1 group2 estimate conf.low conf.high df statistic p effsize magnitude
1 ridge All p1 1 null model 73.093 69.271 76.916 19 12.644 0.000 2.827 large
2 ridge All p2 1 null model 83.863 79.447 88.280 19 16.048 0.000 3.588 large
3 ridge Btw p1 1 null model 70.623 66.911 74.335 19 11.630 0.000 2.600 large
4 ridge Btw p2 1 null model 83.290 79.165 87.414 19 16.893 0.000 3.777 large
19 ridge Vis p1 1 null model 69.450 65.197 73.703 19 9.572 0.000 2.140 large
20 ridge Vis p2 1 null model 74.305 69.367 79.244 19 10.301 0.000 2.303 large
13 ridge SM p1 1 null model 53.281 48.535 58.028 19 1.447 0.164 0.324 small
14 ridge SM p2 1 null model 56.025 51.398 60.652 19 2.725 0.013 0.609 moderate
9 ridge FPN p1 1 null model 69.505 64.792 74.219 19 8.662 0.000 1.937 large
10 ridge FPN p2 1 null model 73.538 67.542 79.534 19 8.216 0.000 1.837 large
17 ridge VAN p1 1 null model 56.474 52.601 60.347 19 3.498 0.002 0.782 moderate
18 ridge VAN p2 1 null model 65.659 60.519 70.799 19 6.376 0.000 1.426 large
5 ridge DAN p1 1 null model 61.976 57.426 66.526 19 5.509 0.000 1.232 large
6 ridge DAN p2 1 null model 69.019 65.894 72.145 19 12.737 0.000 2.848 large
7 ridge DMN p1 1 null model 63.970 60.443 67.497 19 8.290 0.000 1.854 large
8 ridge DMN p2 1 null model 70.933 67.523 74.343 19 12.849 0.000 2.873 large
11 ridge Limb p1 1 null model 51.364 46.267 56.461 19 0.560 0.582 0.125 negligible
12 ridge Limb p2 1 null model 53.824 49.868 57.780 19 2.023 0.057 0.452 small
15 ridge SubCor p1 1 null model 54.230 49.452 59.009 19 1.853 0.080 0.414 small
16 ridge SubCor p2 1 null model 57.281 52.979 61.583 19 3.543 0.002 0.792 moderate


r5_allL.1.tmp <- r5_allL# %>% # filter(netNum == "All")

r5.aov1.tmp <- aov_ez(id="sn", dv="acc", data = r5_allL.1.tmp, within = c("netNum","part"))
# summary(r1.aov1)
nice(r5.aov1.tmp, es="pes") %>% kable(digits=2)
Effect df MSE F pes p.value
netNum 5.29, 100.60 134.99 43.60 *** .697 <.001
part 1, 19 83.84 48.50 *** .719 <.001
netNum:part 6.13, 116.40 62.88 2.98 ** .136 .009
p_h1 <- r5_allL.1.tmp %>% group_by(netNum) %>%
  rstatix::pairwise_t_test(acc ~ part,
                           p.adjust.method="holm",
                           paired=T, detailed=T) %>%
  dplyr::select(netNum, group1, group2, estimate, conf.low, conf.high, df, statistic, p.adj, p.adj.signif)
p_h2 <- r5_allL.1.tmp %>% group_by(netNum) %>%
  rstatix::cohens_d(acc ~ part, paired=T, ci = F) %>%
  dplyr::select(netNum, group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("netNum","group1", "group2")) %>% kable(digits=3)
netNum group1 group2 estimate conf.low conf.high df statistic p.adj p.adj.signif effsize magnitude
All p1 p2 -10.770 -14.646 -6.894 19 -5.816 0.000 **** -1.300 large
Btw p1 p2 -12.667 -16.833 -8.501 19 -6.364 0.000 **** -1.423 large
DAN p1 p2 -7.043 -12.083 -2.004 19 -2.925 0.009 ** -0.654 moderate
DMN p1 p2 -6.963 -10.090 -3.836 19 -4.660 0.000 *** -1.042 large
FPN p1 p2 -4.033 -8.214 0.148 19 -2.019 0.058 ns -0.451 small
Limb p1 p2 -2.460 -7.221 2.301 19 -1.081 0.293 ns -0.242 small
SM p1 p2 -2.743 -6.641 1.154 19 -1.473 0.157 ns -0.329 small
SubCor p1 p2 -3.051 -9.264 3.163 19 -1.028 0.317 ns -0.230 small
VAN p1 p2 -9.185 -14.277 -4.092 19 -3.775 0.001 ** -0.844 large
Vis p1 p2 -4.855 -9.104 -0.606 19 -2.391 0.027 * -0.535 moderate




6.2 MVPC - Ridge, All Group


이어서 전체 참가자를 대상으로 참가자 간 서로 다른 구획별 패턴이 성공적으로 분류되는지 살펴보았다. 분석 모델로는 Ridge를 사용하였다. 참가자 간 패턴 분류 결과는 아래와 같이 계산된다. 먼저 전체 20명의 참가자 중 19명을 Training set으로 구성하고, 나머지 한명을 Test set으로 구성한다. 19명의 Training Set에서는 Run 번호를 기준으로 Leave One Group Out 기법을 수행하여 Train & Validation을 수행한다. 이를 통해 모델 퍼포먼스를 확인하고 나머지 한명의 Test Set에 대하여 Test를 수행한다. 이 과정을 참가자별로 20번 반복하여 20번의 Validation & Testing Accuracy를 평균화하였다.


r7 <- read.csv("py_output/sFC_mvpc_grp_opt3_std2.csv", header = T)

glimpse(r7, width = 70)
## Rows: 200
## Columns: 17
## $ tSN          <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2,…
## $ net          <int> 10, 0, 1, 2, 3, 4, 5, 6, 7, 9, 10, 0, 1, 2, 3, …
## $ classifier   <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,…
## $ vAcc         <dbl> 84.72486, 83.39658, 74.19355, 54.26945, 73.1499…
## $ vAuc         <dbl> 84.72486, 83.39658, 74.19355, 54.26945, 73.1499…
## $ p1_vAcc      <dbl> 83.87097, 82.54269, 72.10626, 54.83871, 70.5882…
## $ p2_vAcc      <dbl> 85.57875, 84.25047, 76.28083, 53.70019, 75.7115…
## $ perm_vAcc    <int> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,…
## $ perm_vChance <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,…
## $ perm_vPval   <int> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,…
## $ tAcc         <dbl> 78.00000, 80.00000, 52.00000, 56.00000, 72.0000…
## $ tAuc         <dbl> 78.00000, 80.00000, 52.00000, 56.00000, 72.0000…
## $ p1_tAcc      <dbl> 60.00000, 68.00000, 76.00000, 44.00000, 60.0000…
## $ p2_tAcc      <dbl> 96.00000, 92.00000, 28.00000, 68.00000, 84.0000…
## $ perm_tAcc    <dbl> 0.8000000, 0.8000000, 0.6400000, 0.5600000, 0.7…
## $ perm_tChance <dbl> 0.5076000, 0.5120000, 0.5202000, 0.4896000, 0.4…
## $ perm_tPval   <dbl> 0.00990099, 0.00990099, 0.05940594, 0.23762376,…

r7_l <- r7 %>% filter(tSN %in% targ_sn)
r7_l$tSN = factor(r7_l$tSN)
r7_l$netNum = factor(r7_l$net,
                     levels = c(10, 0, 1, 2, 3, 4, 5, 6, 7, 9),
                     labels = c('All', 'Btw', 'Vis', 'SM', 'FPN',
                                'VAN', 'DAN', 'DMN', 'Limb', 'SubCor'))
r7_l$net = factor(r7_l$net,
                     levels = c(10, 0, 1, 2, 3, 4, 5, 6, 7, 9),
                     labels = c('All', 'Btw', 'Vis', 'SM', 'FPN',
                                'VAN', 'DAN', 'DMN', 'Limb', 'SubCor'))

r7_l$classf = factor(r7_l$classifier, labels = c('Ridge'))

r7_1 <- r7_l %>% dplyr::select(tSN, net, classifier, vAcc, tAcc)
r7_1 <- gather(r7_1, type, acc, vAcc:tAcc, factor_key=TRUE)
r7_1$type <- factor(r7_1$type, levels=c("vAcc","tAcc"), labels=c("valid","test"))


r7_2 <- r7_l %>% dplyr::select(tSN, net, classifier, 
                               p1_vAcc, p2_vAcc,
                               p1_tAcc, p2_tAcc)
r7_2 <- gather(r7_2, type, acc, p1_vAcc:p2_tAcc, factor_key=TRUE)
r7_2$type <- factor(r7_2$type, 
                    levels=c("p1_vAcc","p2_vAcc","p1_tAcc","p2_tAcc"),
                    labels=c("p1_valid","p2_valid","p1_test","p2_test"))
r7_2 <- separate(r7_2, col=type, sep= "_", into = c("part","type"))
r7_2$type <- factor(r7_2$type, levels=c("valid","test"), labels=c("valid","test"))
r7_2$part <- factor(r7_2$part, levels=c("p1","p2"), labels=c("p1","p2"))


참가자 간 분류의 Validation & Test 결과를 요약하였다.



r7_acc <- r7_l %>% dplyr::select(tSN, net, classifier, vAcc, tAcc) %>% 
  gather(type, acc, vAcc:tAcc, factor_key=T)
r7_acc$acc <- r7_acc$acc
r7_acc$type <- factor(r7_acc$type, levels = c("vAcc", "tAcc"),
                      labels = c("valid", "test"))
r7_acc %>% dplyr::filter(net=="All") %>% 
  dplyr::select(tSN, net, type, acc) %>% spread(key = tSN, value = acc) %>% kable(digits = 1)
net type 1 2 3 4 5 6 7 8 9 10 11 13 14 15 16 17 18 19 20 21
All valid 84.7 84.6 85.6 85.3 85.4 84.6 83.6 83.5 84.4 86.4 82.9 84.0 84.4 85.1 85.6 83.9 84.9 84.0 84.4 86.2
All test 78.0 77.6 85.0 56.2 75.9 89.7 77.6 65.5 86.2 68.5 82.1 70.4 83.3 82.7 66.0 74.1 75.0 88.9 80.8 71.4

r7_p <- r7_l %>% dplyr::select(tSN, net, classifier, perm_vPval, perm_tPval) %>% 
  gather(type, pVal, perm_vPval:perm_tPval, factor_key=T)
r7_p$type <- factor(r7_p$type, levels = c("perm_vPval", "perm_tPval"),
                    labels = c("valid", "test"))
r7_p %>% dplyr::filter(net=="All") %>% 
  dplyr::select(tSN, net, type, pVal) %>% spread(key = tSN, value = pVal) %>% kable(digits = 3)
net type 1 2 3 4 5 6 7 8 9 10 11 13 14 15 16 17 18 19 20 21
All valid 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00
All test 0.01 0.01 0.01 0.04 0.02 0.01 0.01 0.01 0.01 0.01 0.059 0.01 0.01 0.02 0.01 0.01 0.01 0.01 0.01 0.02


# glimpse(r7_1)
# subject-level, long format
r7_11 <- r7_1 %>% dplyr::select(tSN, net, classifier, type, acc)
r7_allL1 <- r7_11 %>% group_by(tSN, net, type) %>%
  dplyr::summarise(acc=mean(acc)) %>%
  ungroup()
## `summarise()` has grouped output by 'tSN', 'net'. You can override using the `.groups` argument.

r7_allW1 <- r7_allL1 %>% spread(key=type, value=acc)

r7_allG1 <- r7_allL1 %>% group_by(net,type) %>%
  dplyr::summarise(acc.m = mean(acc), acc.sd = sd(acc)) %>%
  ungroup()
## `summarise()` has grouped output by 'net'. You can override using the `.groups` argument.
r7_allG1$acc.se <- Rmisc::summarySEwithin(data = r7_allL1, measurevar = "acc", 
                                          idvar = "tSN", withinvars = c("net","type"))$se
r7_allG1$acc.ci <- Rmisc::summarySEwithin(data = r7_allL1, measurevar = "acc", 
                                          idvar = "tSN", withinvars = c("net","type"))$ci
r7_allG1 <- r7_allG1 %>% 
  mutate(lower.ci = acc.m-acc.ci,
         upper.ci = acc.m+acc.ci,
         lower.se = acc.m-acc.se,
         upper.se = acc.m+acc.se)
r7_allG1 %>% dplyr::select(net, type, acc.m, lower.ci, upper.ci) %>% kable(digits = 2)
net type acc.m lower.ci upper.ci
All valid 84.67 83.52 85.82
All test 76.74 73.26 80.23
Btw valid 82.86 81.81 83.91
Btw test 76.42 73.39 79.44
Vis valid 73.06 72.02 74.10
Vis test 72.36 68.12 76.61
SM valid 54.13 53.17 55.08
SM test 53.40 50.43 56.36
FPN valid 73.03 71.84 74.23
FPN test 68.07 64.39 71.76
VAN valid 59.87 58.76 60.97
VAN test 57.13 53.83 60.43
DAN valid 66.57 65.64 67.49
DAN test 63.46 59.84 67.08
DMN valid 64.77 63.67 65.87
DMN test 59.45 56.69 62.22
Limb valid 54.36 53.49 55.23
Limb test 52.93 50.19 55.67
SubCor valid 55.77 54.92 56.62
SubCor test 55.60 52.73 58.47

# subject-level, wide format
r7_21 <- r7_2 %>% dplyr::select(tSN, net, classifier, part, type, acc)
r7_allL2 <- r7_21 %>% group_by(tSN, net, type, part) %>%
  dplyr::summarise(acc=mean(acc)) %>%
  ungroup()
## `summarise()` has grouped output by 'tSN', 'net', 'type'. You can override using the `.groups` argument.
r7_allL2 %>% spread(key = part, value =acc)
## # A tibble: 400 × 5
##    tSN   net   type     p1    p2
##    <fct> <fct> <fct> <dbl> <dbl>
##  1 1     All   valid  83.9  85.6
##  2 1     All   test   60    96  
##  3 1     Btw   valid  82.5  84.3
##  4 1     Btw   test   68    92  
##  5 1     Vis   valid  72.1  76.3
##  6 1     Vis   test   76    28  
##  7 1     SM    valid  54.8  53.7
##  8 1     SM    test   44    68  
##  9 1     FPN   valid  70.6  75.7
## 10 1     FPN   test   60    84  
## # … with 390 more rows
r7_allW2 <- r7_allL2 %>% spread(key = part, value =acc)

r7_allG2 <- r7_allL2 %>% group_by(net ,type, part) %>%
  dplyr::summarise(acc.m = mean(acc), acc.sd = sd(acc)) %>%
  ungroup()
## `summarise()` has grouped output by 'net', 'type'. You can override using the `.groups` argument.
r7_allG2$acc.se <- Rmisc::summarySEwithin(data = r7_allL2, measurevar = "acc", 
                                          idvar = "tSN", withinvars = c("net","type", "part"))$se
r7_allG2$acc.ci <- Rmisc::summarySEwithin(data = r7_allL2, measurevar = "acc", 
                                          idvar = "tSN", withinvars = c("net","type", "part"))$ci
r7_allG2 <- r7_allG2 %>% 
  mutate(lower.ci = acc.m-acc.ci,
         upper.ci = acc.m+acc.ci,
         lower.se = acc.m-acc.se,
         upper.se = acc.m+acc.se)
r7_allG2 %>% dplyr::select(net, type, part, acc.m, lower.ci, upper.ci) %>% kable(digits = 2)
net type part acc.m lower.ci upper.ci
All valid p1 82.80 81.61 83.99
All valid p2 86.55 85.35 87.74
All test p1 72.63 63.68 81.59
All test p2 80.86 71.78 89.93
Btw valid p1 80.99 79.82 82.16
Btw valid p2 84.74 83.78 85.69
Btw test p1 71.81 63.33 80.29
Btw test p2 81.02 73.30 88.75
Vis valid p1 71.80 70.76 72.83
Vis valid p2 74.32 73.28 75.36
Vis test p1 70.83 62.54 79.11
Vis test p2 73.90 64.26 83.54
SM valid p1 55.00 54.09 55.91
SM valid p2 53.26 52.17 54.35
SM test p1 51.41 41.86 60.96
SM test p2 55.38 46.49 64.27
FPN valid p1 70.41 69.28 71.55
FPN valid p2 75.66 74.35 76.96
FPN test p1 66.95 59.11 74.79
FPN test p2 69.19 60.68 77.70
VAN valid p1 58.47 57.39 59.54
VAN valid p2 61.27 60.11 62.43
VAN test p1 54.48 41.99 66.98
VAN test p2 59.78 46.52 73.05
DAN valid p1 66.24 65.31 67.17
DAN valid p2 66.90 65.92 67.87
DAN test p1 58.14 46.92 69.35
DAN test p2 68.78 62.25 75.31
DMN valid p1 63.15 62.04 64.25
DMN valid p2 66.39 65.23 67.54
DMN test p1 57.75 47.09 68.41
DMN test p2 61.16 51.53 70.79
Limb valid p1 53.61 52.58 54.64
Limb valid p2 55.11 54.30 55.92
Limb test p1 52.23 40.50 63.95
Limb test p2 53.64 41.48 65.79
SubCor valid p1 54.45 53.50 55.40
SubCor valid p2 57.09 56.25 57.94
SubCor test p1 53.64 45.42 61.86
SubCor test p2 57.56 48.65 66.47


library(RColorBrewer)
# display.brewer.all()


r7_allL.1 <- r7_allL1 #%>% filter(netNum == 'All')
r7_allG.1 <- r7_allG1 #%>% filter(netNum == 'All')
# r7_allG.1 <- r7_allW %>% filter(netNum == 'All')
r7.p1.all.plot1 <- ggplot(data=r7_allL.1, aes(x=type, y=acc, fill=type, shpae=type)) +
  stat_summary(fun = mean, geom = "bar", position="dodge", 
               na.rm = TRUE, alpha = .9, width = 0.8,  size = 0.15, color = "black") +
  geom_hline(yintercept=50, linetype='dashed', color="gray20", alpha =1, size=1) +
  facet_grid(.~net, scales="free_x", space = "free") + 
             #labeller = labeller(type = c("valid" = "valid",
            #                                "test" = "test\nSVM"))) +
  # geom_dotplot(binaxis = "y", stackdir = "center", stackratio = 0.5,
  #              color = "black", alpha = 0.5, #position = "nudge",
  #              position = position_jitter(0.15),
  #              inherit.aes = TRUE, binwidth = 0.4) +
  # geom_jitter(aes(x=cond, y=z, fill=cond,color = cond), 
  #             position=position_jitter(0.1), cex=2
  #             ) + 
  geom_segment(data=r7_allW1, inherit.aes = FALSE,
               aes(x=1, y=filter(r7_allW1)$valid,
                   xend=2, yend=filter(r7_allW1)$test),
               color="gray90", alpha = .7) +
  geom_point(data=r7_allL.1, aes(x=type, y=acc, fill=type), position = position_dodge(width=0.8),
             size=2, show.legend=F, color="gray90") +
  geom_errorbar(data=r7_allG.1, aes(x=type, y= acc.m, ymin=acc.m-acc.ci, ymax=acc.m+acc.ci), width=.2,
                position=position_dodge(.8), color = "black") +
  scale_fill_brewer(palette="Set2", labels = c('Validation','Test')) + 
  coord_cartesian(ylim = c(0, 100), clip = "on") +
  labs(x = "Network", y = "Classification Accuracy") +
    ggtitle("Group-Level, Ridge, Validation vs. Test") +
  theme_bw(base_size = 18) +
  theme(axis.text.x=element_blank(),
        axis.ticks.x=element_blank(),
        axis.title = element_text(face = "bold", size = 16, color = "black"),
        axis.text = element_text(face = "plain", hjust = 0.5, size = 15, color = "black"),
        axis.line=element_line(),
        strip.text.x = element_text(face = "plain", size = 15, color = "black"),
        strip.background = element_blank(),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.border = element_blank(),
        panel.spacing=unit(1, "lines"),
        plot.margin = margin(1, 0.3, 1, 0.3, "cm"), 
        legend.title = element_blank(),
        legend.position="bottom")
# plot-control 3
# ggsave("fig1_1.fmri.jpg", plot = r3.p1.all.plot1, width=6, height=6, unit='in', dpi=600)
r7.p1.all.plot1


library(RColorBrewer)
# display.brewer.all()

r7_allL.2 <- r7_allL2 %>% filter(type == 'test')
r7_allW2.2 <- r7_allW2 %>% filter(type == 'test')
r7_allG.2 <- r7_allG2 %>% filter(type == 'test')
# r7_allG.2 <- r7_allW %>% filter(netNum == 'All')
r7.p1.all.plot2 <- ggplot(data=r7_allL.2, aes(x=part, y=acc, fill=part, shpae=part)) +
  stat_summary(fun = mean, geom = "bar", position="dodge", 
               na.rm = TRUE, alpha = .9, width = 0.8,  size = 0.15, color = "black") +
  facet_grid(.~net, scales="free_x", space = "free") + 
  geom_hline(yintercept=50, linetype='dashed', color="gray20", alpha =1, size=1) +
  geom_point(data=r7_allL.2, aes(x=part, y=acc, fill=part), position = position_dodge(width=0.8),
             size=2, show.legend=F, color="gray90") +
  
  geom_segment(data=r7_allW2.2, inherit.aes = FALSE,
               aes(x=1, y=filter(r7_allW2.2)$p1,
                   xend=2, yend=filter(r7_allW2.2)$p2),
               color="gray90", alpha = .7) +
  
  
  geom_errorbar(data=r7_allG.2, aes(x=part, y= acc.m, ymin=acc.m-acc.se, ymax=acc.m+acc.se), width=.2,
                position=position_dodge(.8), color = "black") +
  scale_fill_manual(values = c("#ED7D31", "#5B9BD5"), # c("#ED7D31", "#5B9BD5", "#70AD47"),
                    labels = c("First Half", "Second Half")) +
  coord_cartesian(ylim = c(0, 100), clip = "on") +
  labs(x = "Type", y = "Test Accuracy") +
  # scale_x_discrete(labels=c("Validation", "Test")) +
  ggtitle("Group-Level, Ridge, First vs. Second") +
  theme_bw(base_size = 18) +
  theme(axis.text.x=element_blank(),
        axis.ticks.x=element_blank(),
        axis.title = element_text(face = "bold", size = 16, color = "black"),
        axis.text = element_text(face = "plain", hjust = 0.5, size = 15, color = "black"),
        axis.line=element_line(),
        strip.text.x = element_text(face = "plain", size = 15, color = "black"),
        strip.background = element_blank(),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.border = element_blank(),
        panel.spacing=unit(1, "lines"),
        plot.margin = margin(1, 0.3, 1, 0.3, "cm"), 
        legend.title = element_blank(),
        legend.position="bottom")
# plot-control 3
# ggsave("fig1_1.fmri.jpg", plot = r3.p1.all.plot1, width=6, height=6, unit='in', dpi=600)
r7.p1.all.plot2


분류 결과가 Chance Level인 50% 보다 유의하게 큰지 확인하였다.


r7_allL.1.tmp <- r7_allL1
p_h1 <- r7_allL.1.tmp %>% group_by(net, type) %>% 
  rstatix::t_test(acc ~ 1, mu = 50,
                  detailed=T) %>%
  dplyr::select(net, type, group1, group2, estimate, conf.low, conf.high, df, statistic, p)
p_h2 <- r7_allL.1.tmp %>% group_by(net, type) %>% 
  rstatix::cohens_d(acc ~ 1, mu = 50, ci = F) %>%
  dplyr::select(net, type, group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("net", "type", "group1", "group2")) %>% kable(digits=3)
net type group1 group2 estimate conf.low conf.high df statistic p effsize magnitude
All test 1 null model 76.744 72.715 80.773 19 13.894 0.000 3.107 large
All valid 1 null model 84.672 84.249 85.096 19 171.508 0.000 38.350 large
Btw test 1 null model 76.417 72.797 80.036 19 15.278 0.000 3.416 large
Btw valid 1 null model 82.861 82.553 83.170 19 223.208 0.000 49.911 large
DAN test 1 null model 63.458 59.883 67.033 19 7.880 0.000 1.762 large
DAN valid 1 null model 66.567 66.309 66.825 19 134.323 0.000 30.035 large
DMN test 1 null model 59.454 56.214 62.693 19 6.108 0.000 1.366 large
DMN valid 1 null model 64.768 64.393 65.144 19 82.340 0.000 18.412 large
FPN test 1 null model 68.071 64.025 72.117 19 9.348 0.000 2.090 large
FPN valid 1 null model 73.035 72.599 73.470 19 110.743 0.000 24.763 large
Limb test 1 null model 52.931 50.081 55.782 19 2.152 0.044 0.481 small
Limb valid 1 null model 54.363 54.099 54.627 19 34.606 0.000 7.738 large
SM test 1 null model 53.396 50.561 56.231 19 2.507 0.021 0.561 moderate
SM valid 1 null model 54.128 53.851 54.406 19 31.134 0.000 6.962 large
SubCor test 1 null model 55.600 52.637 58.562 19 3.956 0.001 0.885 large
SubCor valid 1 null model 55.773 55.531 56.016 19 49.791 0.000 11.134 large
VAN test 1 null model 57.133 53.514 60.752 19 4.125 0.001 0.922 large
VAN valid 1 null model 59.867 59.515 60.220 19 58.583 0.000 13.100 large
Vis test 1 null model 72.363 67.833 76.893 19 10.333 0.000 2.311 large
Vis valid 1 null model 73.059 72.757 73.361 19 159.845 0.000 35.743 large


r7_allL.1.tmp <- r7_allL1

r7.aov1.tmp <- aov_ez(id="tSN", dv="acc", data = r7_allL.1.tmp, within = c("net","type"))
# summary(r1.aov1)
nice(r7.aov1.tmp, es="pes") %>% kable(digits=2)
Effect df MSE F pes p.value
net 5.26, 99.90 38.67 185.57 *** .907 <.001
type 1, 19 83.29 13.50 ** .415 .002
net:type 5.48, 104.10 42.41 2.80 * .129 .017
p_h1 <- r7_allL.1.tmp %>% group_by(net) %>% 
  rstatix::pairwise_t_test(acc ~ type,
                           p.adjust.method="holm",
                           paired=T, detailed=T) %>%
  dplyr::select(net, group1, group2, estimate, conf.low, conf.high, df, statistic, p.adj, p.adj.signif)
p_h2 <- r7_allL.1.tmp %>% group_by(net) %>% 
  rstatix::cohens_d(acc ~ type, paired=T, ci = F) %>%
  dplyr::select(net, group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("net","group1", "group2")) %>% kable(digits=3)
net group1 group2 estimate conf.low conf.high df statistic p.adj p.adj.signif effsize magnitude
All valid test 7.928 3.763 12.093 19 3.984 0.001 *** 0.891 large
Btw valid test 6.445 2.771 10.118 19 3.672 0.002 ** 0.821 large
DAN valid test 3.109 -0.524 6.741 19 1.791 0.089 ns 0.401 small
DMN valid test 5.315 1.872 8.757 19 3.232 0.004 ** 0.723 moderate
FPN valid test 4.963 0.670 9.256 19 2.420 0.026 * 0.541 moderate
Limb valid test 1.431 -1.509 4.372 19 1.019 0.321 ns 0.228 small
SM valid test 0.732 -2.250 3.715 19 0.514 0.613 ns 0.115 negligible
SubCor valid test 0.174 -2.836 3.184 19 0.121 0.905 ns 0.027 negligible
VAN valid test 2.734 -1.081 6.550 19 1.500 0.150 ns 0.335 small
Vis valid test 0.696 -4.078 5.470 19 0.305 0.763 ns 0.068 negligible
p_h1 <- r7_allL.1.tmp %>% group_by(type) %>% 
  rstatix::pairwise_t_test(acc ~ net,
                           p.adjust.method="holm",
                           paired=T, detailed=T) %>%
  dplyr::select(type, group1, group2, estimate, conf.low, conf.high, df, statistic, p.adj, p.adj.signif)
p_h2 <- r7_allL.1.tmp %>% group_by(type) %>% 
  rstatix::cohens_d(acc ~ net, paired=T, ci = F) %>%
  dplyr::select(type, group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("type","group1", "group2")) %>% kable(digits=3)
type group1 group2 estimate conf.low conf.high df statistic p.adj p.adj.signif effsize magnitude
test All Btw 0.328 -1.689 2.345 19 0.340 1.000 ns 0.076 negligible
test All DAN 13.286 8.308 18.264 19 5.587 0.001 *** 1.249 large
test All DMN 17.291 13.493 21.088 19 9.529 0.000 **** 2.131 large
test All FPN 8.673 4.543 12.803 19 4.395 0.007 ** 0.983 large
test All Limb 23.813 18.749 28.876 19 9.843 0.000 **** 2.201 large
test All SM 23.348 18.481 28.215 19 10.042 0.000 **** 2.245 large
test All SubCor 21.145 16.610 25.679 19 9.760 0.000 **** 2.182 large
test All VAN 19.611 14.796 24.427 19 8.524 0.000 **** 1.906 large
test All Vis 4.381 -0.402 9.165 19 1.917 0.774 ns 0.429 small
test Btw DAN 12.958 8.550 17.367 19 6.152 0.000 *** 1.376 large
test Btw DMN 16.963 13.279 20.647 19 9.638 0.000 **** 2.155 large
test Btw FPN 8.345 4.635 12.055 19 4.708 0.004 ** 1.053 large
test Btw Limb 23.485 18.991 27.979 19 10.938 0.000 **** 2.446 large
test Btw SM 23.021 18.389 27.652 19 10.404 0.000 **** 2.326 large
test Btw SubCor 20.817 16.716 24.918 19 10.623 0.000 **** 2.375 large
test Btw VAN 19.284 14.992 23.576 19 9.404 0.000 **** 2.103 large
test Btw Vis 4.054 -0.833 8.940 19 1.736 0.978 ns 0.388 small
test DAN DMN 4.005 -0.907 8.916 19 1.707 0.978 ns 0.382 small
test DAN Limb 10.527 5.454 15.599 19 4.343 0.007 ** 0.971 large
test DAN SubCor 7.859 2.157 13.560 19 2.885 0.161 ns 0.645 moderate
test DMN Limb 6.522 3.205 9.840 19 4.115 0.011 * 0.920 large
test DMN SubCor 3.854 -0.010 7.718 19 2.088 0.606 ns 0.467 small
test FPN DAN 4.613 0.622 8.604 19 2.419 0.360 ns 0.541 moderate
test FPN DMN 8.618 4.531 12.704 19 4.414 0.007 ** 0.987 large
test FPN Limb 15.140 10.445 19.835 19 6.750 0.000 **** 1.509 large
test FPN SubCor 12.472 6.875 18.068 19 4.664 0.004 ** 1.043 large
test FPN VAN 10.938 6.140 15.736 19 4.772 0.003 ** 1.067 large
test Limb SubCor -2.668 -5.875 0.539 19 -1.741 0.978 ns -0.389 small
test SM DAN -10.062 -14.824 -5.300 19 -4.422 0.007 ** -0.989 large
test SM DMN -6.057 -10.510 -1.605 19 -2.848 0.165 ns -0.637 moderate
test SM FPN -14.675 -19.469 -9.882 19 -6.408 0.000 *** -1.433 large
test SM Limb 0.465 -3.670 4.599 19 0.235 1.000 ns 0.053 negligible
test SM SubCor -2.204 -6.668 2.261 19 -1.033 1.000 ns -0.231 small
test SM VAN -3.737 -8.410 0.936 19 -1.674 0.978 ns -0.374 small
test VAN DAN -6.325 -11.924 -0.727 19 -2.365 0.374 ns -0.529 moderate
test VAN DMN -2.321 -6.335 1.694 19 -1.210 1.000 ns -0.271 small
test VAN Limb 4.201 0.631 7.772 19 2.463 0.352 ns 0.551 moderate
test VAN SubCor 1.533 -1.801 4.868 19 0.962 1.000 ns 0.215 small
test Vis DAN 8.905 2.705 15.104 19 3.006 0.131 ns 0.672 moderate
test Vis DMN 12.909 8.807 17.011 19 6.587 0.000 **** 1.473 large
test Vis FPN 4.291 -2.132 10.714 19 1.398 1.000 ns 0.313 small
test Vis Limb 19.431 14.246 24.617 19 7.843 0.000 **** 1.754 large
test Vis SM 18.967 13.741 24.192 19 7.597 0.000 **** 1.699 large
test Vis SubCor 16.763 12.205 21.322 19 7.697 0.000 **** 1.721 large
test Vis VAN 15.230 10.115 20.345 19 6.232 0.000 *** 1.394 large
valid All Btw 1.811 1.453 2.169 19 10.592 0.000 **** 2.368 large
valid All DAN 18.106 17.556 18.655 19 68.958 0.000 **** 15.419 large
valid All DMN 19.904 19.357 20.451 19 76.137 0.000 **** 17.025 large
valid All FPN 11.638 11.057 12.219 19 41.950 0.000 **** 9.380 large
valid All Limb 30.309 29.799 30.820 19 124.191 0.000 **** 27.770 large
valid All SM 30.544 29.997 31.091 19 116.812 0.000 **** 26.120 large
valid All SubCor 28.899 28.521 29.277 19 160.051 0.000 **** 35.788 large
valid All VAN 24.805 24.259 25.352 19 94.978 0.000 **** 21.238 large
valid All Vis 11.613 11.095 12.131 19 46.933 0.000 **** 10.494 large
valid Btw DAN 16.295 15.814 16.775 19 71.012 0.000 **** 15.879 large
valid Btw DMN 18.093 17.681 18.506 19 91.777 0.000 **** 20.522 large
valid Btw FPN 9.827 9.309 10.345 19 39.722 0.000 **** 8.882 large
valid Btw Limb 28.498 28.062 28.935 19 136.577 0.000 **** 30.539 large
valid Btw SM 28.733 28.301 29.165 19 139.266 0.000 **** 31.141 large
valid Btw SubCor 27.088 26.772 27.403 19 179.692 0.000 **** 40.180 large
valid Btw VAN 22.994 22.489 23.499 19 95.316 0.000 **** 21.313 large
valid Btw Vis 9.802 9.403 10.202 19 51.312 0.000 **** 11.474 large
valid DAN DMN 1.799 1.314 2.284 19 7.762 0.000 **** 1.736 large
valid DAN Limb 12.204 11.875 12.533 19 77.581 0.000 **** 17.348 large
valid DAN SubCor 10.793 10.395 11.191 19 56.736 0.000 **** 12.686 large
valid DMN Limb 10.405 9.824 10.986 19 37.494 0.000 **** 8.384 large
valid DMN SubCor 8.995 8.546 9.443 19 42.003 0.000 **** 9.392 large
valid FPN DAN 6.468 5.979 6.956 19 27.709 0.000 **** 6.196 large
valid FPN DMN 8.266 7.763 8.769 19 34.401 0.000 **** 7.692 large
valid FPN Limb 18.672 18.137 19.206 19 73.150 0.000 **** 16.357 large
valid FPN SubCor 17.261 16.700 17.822 19 64.388 0.000 **** 14.398 large
valid FPN VAN 13.167 12.752 13.583 19 66.362 0.000 **** 14.839 large
valid Limb SubCor -1.411 -1.789 -1.032 19 -7.808 0.000 **** -1.746 large
valid SM DAN -12.438 -12.841 -12.036 19 -64.694 0.000 **** -14.466 large
valid SM DMN -10.640 -11.120 -10.159 19 -46.336 0.000 **** -10.361 large
valid SM FPN -18.906 -19.379 -18.434 19 -83.747 0.000 **** -18.726 large
valid SM Limb -0.235 -0.646 0.177 19 -1.192 0.496 ns -0.266 small
valid SM SubCor -1.645 -2.059 -1.231 19 -8.313 0.000 **** -1.859 large
valid SM VAN -5.739 -6.097 -5.380 19 -33.486 0.000 **** -7.488 large
valid VAN DAN -6.700 -7.149 -6.250 19 -31.198 0.000 **** -6.976 large
valid VAN DMN -4.901 -5.443 -4.359 19 -18.918 0.000 **** -4.230 large
valid VAN Limb 5.504 5.054 5.954 19 25.608 0.000 **** 5.726 large
valid VAN SubCor 4.094 3.606 4.582 19 17.556 0.000 **** 3.926 large
valid Vis DAN 6.492 6.134 6.850 19 37.954 0.000 **** 8.487 large
valid Vis DMN 8.291 7.885 8.696 19 42.801 0.000 **** 9.571 large
valid Vis FPN 0.025 -0.466 0.515 19 0.105 0.918 ns 0.023 negligible
valid Vis Limb 18.696 18.241 19.151 19 86.060 0.000 **** 19.243 large
valid Vis SM 18.931 18.631 19.230 19 132.451 0.000 **** 29.617 large
valid Vis SubCor 17.286 16.870 17.701 19 87.123 0.000 **** 19.481 large
valid Vis VAN 13.192 12.757 13.627 19 63.449 0.000 **** 14.188 large


r7_allL.1.tmp <- r7_allL2
p_h1 <- r7_allL.1.tmp %>% group_by(net, type, part) %>% 
  rstatix::t_test(acc ~ 1, mu = 50,
                  detailed=T) %>%
  dplyr::select(net, type, part, group1, group2, estimate, conf.low, conf.high, df, statistic, p)
p_h2 <- r7_allL.1.tmp %>% group_by(net, type, part) %>% 
  rstatix::cohens_d(acc ~ 1, mu = 50, ci = F) %>%
  dplyr::select(net, type, part, group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("net","type", "part", "group1", "group2")) %>% kable(digits=3)
net type part group1 group2 estimate conf.low conf.high df statistic p effsize magnitude
All test p1 1 null model 72.631 63.328 81.934 19 5.091 0.000 1.138 large
All test p2 1 null model 80.857 71.842 89.872 19 7.164 0.000 1.602 large
All valid p1 1 null model 82.799 82.194 83.404 19 113.457 0.000 25.370 large
All valid p2 1 null model 86.546 86.048 87.043 19 153.725 0.000 34.374 large
Btw test p1 1 null model 71.810 63.040 80.580 19 5.205 0.000 1.164 large
Btw test p2 1 null model 81.023 73.267 88.779 19 8.372 0.000 1.872 large
Btw valid p1 1 null model 80.987 80.540 81.435 19 144.877 0.000 32.396 large
Btw valid p2 1 null model 84.736 84.380 85.091 19 204.650 0.000 45.761 large
DAN test p1 1 null model 58.135 47.252 69.019 19 1.565 0.134 0.350 small
DAN test p2 1 null model 68.781 61.962 75.600 19 5.765 0.000 1.289 large
DAN valid p1 1 null model 66.238 65.848 66.627 19 87.271 0.000 19.514 large
DAN valid p2 1 null model 66.896 66.526 67.266 19 95.570 0.000 21.370 large
DMN test p1 1 null model 57.749 46.759 68.740 19 1.476 0.156 0.330 small
DMN test p2 1 null model 61.158 51.832 70.483 19 2.504 0.021 0.560 moderate
DMN valid p1 1 null model 63.147 62.665 63.629 19 57.070 0.000 12.761 large
DMN valid p2 1 null model 66.389 65.892 66.886 19 68.986 0.000 15.426 large
FPN test p1 1 null model 66.953 59.104 74.801 19 4.521 0.000 1.011 large
FPN test p2 1 null model 69.190 60.481 77.899 19 4.612 0.000 1.031 large
FPN valid p1 1 null model 70.413 69.992 70.834 19 101.566 0.000 22.711 large
FPN valid p2 1 null model 75.656 75.032 76.280 19 86.058 0.000 19.243 large
Limb test p1 1 null model 52.226 40.764 63.688 19 0.407 0.689 0.091 negligible
Limb test p2 1 null model 53.637 41.441 65.833 19 0.624 0.540 0.140 negligible
Limb valid p1 1 null model 53.614 53.108 54.120 19 14.961 0.000 3.345 large
Limb valid p2 1 null model 55.112 54.769 55.455 19 31.193 0.000 6.975 large
SM test p1 1 null model 51.412 42.176 60.648 19 0.320 0.753 0.072 negligible
SM test p2 1 null model 55.380 46.435 64.325 19 1.259 0.223 0.281 small
SM valid p1 1 null model 54.996 54.627 55.366 19 28.315 0.000 6.331 large
SM valid p2 1 null model 53.261 52.758 53.764 19 13.566 0.000 3.034 large
SubCor test p1 1 null model 53.638 45.431 61.846 19 0.928 0.365 0.207 small
SubCor test p2 1 null model 57.561 48.742 66.380 19 1.794 0.089 0.401 small
SubCor valid p1 1 null model 54.452 54.027 54.878 19 21.886 0.000 4.894 large
SubCor valid p2 1 null model 57.095 56.740 57.449 19 41.877 0.000 9.364 large
VAN test p1 1 null model 54.484 41.739 67.228 19 0.736 0.471 0.165 negligible
VAN test p2 1 null model 59.782 46.863 72.702 19 1.585 0.130 0.354 small
VAN valid p1 1 null model 58.466 58.081 58.851 19 46.016 0.000 10.290 large
VAN valid p2 1 null model 61.268 60.808 61.729 19 51.201 0.000 11.449 large
Vis test p1 1 null model 70.826 62.480 79.172 19 5.223 0.000 1.168 large
Vis test p2 1 null model 73.900 64.170 83.629 19 5.141 0.000 1.150 large
Vis valid p1 1 null model 71.796 71.484 72.107 19 146.563 0.000 32.772 large
Vis valid p2 1 null model 74.322 73.932 74.713 19 130.297 0.000 29.135 large


네트워크 별, 타입 별 (Valid vs. Test)로 정확도 차이가 있는지 살펴본다.


r7_allL.1.tmp <- r7_allL2

r7.aov1.tmp <- aov_ez(id="tSN", dv="acc", data = r7_allL.1.tmp, within = c("net","type", "part"))
# summary(r1.aov1)
nice(r7.aov1.tmp, es="pes") %>% kable(digits=2)
Effect df MSE F pes p.value
net 5.26, 99.90 77.35 185.57 *** .907 <.001
type 1, 19 166.57 13.50 ** .415 .002
part 1, 19 520.96 5.51 * .225 .030
net:type 5.48, 104.10 84.81 2.80 * .129 .017
net:part 5.35, 101.57 607.31 0.18 .010 .974
type:part 1, 19 516.67 0.71 .036 .411
net:type:part 5.39, 102.36 599.58 0.20 .010 .970
p_h1 <- r7_allL.1.tmp %>% group_by(net, part) %>% 
  rstatix::pairwise_t_test(acc ~ type,
                           p.adjust.method="holm",
                           paired=T, detailed=T) %>%
  dplyr::select(net, part, group1, group2, estimate, conf.low, conf.high, df, statistic, p.adj, p.adj.signif)
p_h2 <- r7_allL.1.tmp %>% group_by(net ,part) %>% 
  rstatix::cohens_d(acc ~ type, paired=T, ci = F) %>%
  dplyr::select(net, part, group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("net","part", "group1", "group2")) %>% kable(digits=3)
net part group1 group2 estimate conf.low conf.high df statistic p.adj p.adj.signif effsize magnitude
All p1 valid test 10.168 0.874 19.462 19 2.290 0.034 * 0.512 moderate
All p2 valid test 5.689 -3.380 14.758 19 1.313 0.205 ns 0.294 small
Btw p1 valid test 9.177 0.387 17.968 19 2.185 0.042 * 0.489 small
Btw p2 valid test 3.712 -4.130 11.555 19 0.991 0.334 ns 0.222 small
DAN p1 valid test 8.102 -2.765 18.969 19 1.560 0.135 ns 0.349 small
DAN p2 valid test -1.885 -8.730 4.961 19 -0.576 0.571 ns -0.129 negligible
DMN p1 valid test 5.398 -5.617 16.412 19 1.026 0.318 ns 0.229 small
DMN p2 valid test 5.231 -4.081 14.544 19 1.176 0.254 ns 0.263 small
FPN p1 valid test 3.460 -4.529 11.449 19 0.907 0.376 ns 0.203 small
FPN p2 valid test 6.466 -2.494 15.426 19 1.511 0.147 ns 0.338 small
Limb p1 valid test 1.388 -9.923 12.699 19 0.257 0.800 ns 0.057 negligible
Limb p2 valid test 1.475 -10.719 13.669 19 0.253 0.803 ns 0.057 negligible
SM p1 valid test 3.584 -5.760 12.929 19 0.803 0.432 ns 0.180 negligible
SM p2 valid test -2.120 -11.092 6.852 19 -0.494 0.627 ns -0.111 negligible
SubCor p1 valid test 0.814 -7.374 9.003 19 0.208 0.837 ns 0.047 negligible
SubCor p2 valid test -0.466 -9.257 8.324 19 -0.111 0.913 ns -0.025 negligible
VAN p1 valid test 3.982 -8.756 16.721 19 0.654 0.521 ns 0.146 negligible
VAN p2 valid test 1.486 -11.576 14.548 19 0.238 0.814 ns 0.053 negligible
Vis p1 valid test 0.970 -7.506 9.446 19 0.239 0.813 ns 0.054 negligible
Vis p2 valid test 0.423 -9.574 10.420 19 0.089 0.930 ns 0.020 negligible
p_h1 <- r7_allL.1.tmp %>% group_by(net, type) %>% 
  rstatix::pairwise_t_test(acc ~ part,
                           p.adjust.method="holm",
                           paired=T, detailed=T) %>%
  dplyr::select(net, type, group1, group2, estimate, conf.low, conf.high, df, statistic, p.adj, p.adj.signif)
p_h2 <- r7_allL.1.tmp %>% group_by(net, type) %>% 
  rstatix::cohens_d(acc ~ part, paired=T, ci = F) %>%
  dplyr::select(net, type, group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("net","type", "group1", "group2")) %>% kable(digits=3)
net type group1 group2 estimate conf.low conf.high df statistic p.adj p.adj.signif effsize magnitude
All test p1 p2 -8.226 -24.679 8.227 19 -1.046 0.308 ns -0.234 small
All valid p1 p2 -3.747 -4.462 -3.032 19 -10.969 0.000 **** -2.453 large
Btw test p1 p2 -9.214 -24.105 5.677 19 -1.295 0.211 ns -0.290 small
Btw valid p1 p2 -3.748 -4.271 -3.225 19 -15.004 0.000 **** -3.355 large
DAN test p1 p2 -10.645 -27.342 6.052 19 -1.334 0.198 ns -0.298 small
DAN valid p1 p2 -0.659 -1.216 -0.101 19 -2.473 0.023 * -0.553 moderate
DMN test p1 p2 -3.408 -22.735 15.918 19 -0.369 0.716 ns -0.083 negligible
DMN valid p1 p2 -3.242 -3.871 -2.613 19 -10.785 0.000 **** -2.412 large
FPN test p1 p2 -2.237 -16.708 12.233 19 -0.324 0.750 ns -0.072 negligible
FPN valid p1 p2 -5.243 -5.855 -4.631 19 -17.931 0.000 **** -4.010 large
Limb test p1 p2 -1.411 -24.383 21.562 19 -0.129 0.899 ns -0.029 negligible
Limb valid p1 p2 -1.498 -2.182 -0.814 19 -4.582 0.000 *** -1.025 large
SM test p1 p2 -3.968 -21.245 13.308 19 -0.481 0.636 ns -0.108 negligible
SM valid p1 p2 1.736 1.049 2.422 19 5.294 0.000 **** 1.184 large
SubCor test p1 p2 -3.923 -19.897 12.051 19 -0.514 0.613 ns -0.115 negligible
SubCor valid p1 p2 -2.642 -3.257 -2.027 19 -8.989 0.000 **** -2.010 large
VAN test p1 p2 -5.299 -29.921 19.323 19 -0.450 0.658 ns -0.101 negligible
VAN valid p1 p2 -2.802 -3.275 -2.329 19 -12.398 0.000 **** -2.772 large
Vis test p1 p2 -3.074 -18.776 12.629 19 -0.410 0.687 ns -0.092 negligible
Vis valid p1 p2 -2.527 -2.893 -2.160 19 -14.425 0.000 **** -3.226 large




6.3 Representational Similarity Analysis


분류 분석 결과를 보충하기 위해 연결성 패턴에 대한 RSA 분석을 Matlab으로 수행하였다. 결과적으로 산출된 패턴 유사성에 대한 통계 분석을 수행한다.


r1 <- read.csv("data/r1_p1_sum_opt3.csv", header = T)
glimpse(r1, width = 70)
## Rows: 6,300
## Columns: 13
## $ sn        <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,…
## $ stimIdx   <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2,…
## $ netLabel  <chr> "all_net", "1. Visual", "2. SM", "3. Control", "4.…
## $ netNum    <int> 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 1, 2, 3, 4, 5, 6,…
## $ nNode     <int> 122, 10, 10, 26, 24, 14, 24, 4, 2, 8, 122, 10, 10,…
## $ wn_p12    <dbl> 0.51648812, 0.57755802, 0.79987237, 0.52463983, 0.…
## $ btw_allTC <dbl> 0.60738852, 0.68024602, 0.80848798, 0.65970557, 0.…
## $ btw_p1    <dbl> 0.4937307, 0.5697070, 0.7125933, 0.5346186, 0.6272…
## $ btw_p2    <dbl> 0.43224876, 0.52106184, 0.73739015, 0.47575150, 0.…
## $ btw_p12   <dbl> 0.47115401, 0.54201473, 0.70614239, 0.52909839, 0.…
## $ btw_p21   <dbl> 0.418809920, 0.581627503, 0.738730401, 0.457762519…
## $ run       <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 10, 10, 10, 10, 10, …
## $ order     <int> 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3,…

r1_l <- r1 %>% filter(sn %in% targ_sn)
r1_l$sn = factor(r1_l$sn)
r1_l$stimIdx = factor(r1_l$stimIdx)
r1_l$netLabel = factor(r1_l$netLabel, 
                       levels = c('all_net',
                                  '1. Visual',
                                  '2. SM',
                                  '3. Control',
                                  '4. Sal/vAtt',
                                  '5. DAN',
                                  '6. DMN',
                                  '7. Limbic',
                                  '8. TP',
                                  '9. SubCor'),
                       labels = c('All','Vis','SM','FPN','VAN','DAN','DMN','Limb','TP','SubCor'))


r1_l$netNum = factor(r1_l$netNum)
r1_l$run = factor(r1_l$run)
r1_l$order = factor(r1_l$order)

r1_l <- merge(r1_l, bh_t, by= c('sn', 'stimIdx'))
r1_l <- r1_l %>% filter(check == 0) %>% filter(corr == 1)

r1_1 = r1_l %>% dplyr::select(sn, stimIdx, netLabel, netNum, nNode, run, order, 
                              wn_p12, btw_p12, btw_p21)
r1_2 = r1_l %>% dplyr::select(sn, stimIdx, netLabel, netNum, nNode, run, order, 
                              btw_allTC, btw_p1, btw_p2)

r1_3 = r1_l %>% dplyr::select(sn, stimIdx, netLabel, netNum, nNode, run, order, 
                              btw_p1, btw_p2, btw_p12, btw_p21)


r1_1 <- gather(r1_1, key = type, value = r_type, wn_p12:btw_p21)
r1_1$type <- factor(r1_1$type, 
                    levels = c('wn_p12', 
                               'btw_p12', 'btw_p21'),
                    labels = c('self12',
                               'other12',
                               'other21'))

r1_2 <- gather(r1_2, key = part, value = r_part, btw_allTC:btw_p2)
r1_2$part <- factor(r1_2$part, 
                    levels = c("btw_allTC", "btw_p1", "btw_p2"),
                    labels = c('all', 'p1', 'p2'))


r1_3 <- gather(r1_3, key = part, value = r_part, btw_p1:btw_p21)
r1_3$part <- factor(r1_3$part, 
                    levels = c("btw_p1", "btw_p2",
                               "btw_p12", 
                               "btw_p21"),
                    labels = c('p1_wn', 'p2_wn',
                               'p1_2', 'p2_1'))


6.3.1 RSA : Within Stim vs. Between Stim


먼저 각 영상별로 고유한 패턴이 있는지 확인하기 위해 within 영상, between 영상 간 패턴 유사성을 비교하였다.


# glimpse(r1_1)
# subject-level, long format
r1_allL <- r1_1 %>% group_by(sn, netLabel, type) %>%
  dplyr::summarise(r=mean(r_type)) %>%
  ungroup()
## `summarise()` has grouped output by 'sn', 'netLabel'. You can override using the `.groups` argument.
# r1_allL %>% kable(digits=2)

# subject-level, wide format
r1_allW <- r1_allL %>% spread(key=type, value = r)
r1_allL.1 <- r1_allW %>% mutate(self = (self12),
                                other = (other12+other21)/2) %>% 
  dplyr::select(sn, netLabel, self, other) %>% 
  gather(key = type, value = r, self:other, factor_key = T)
r1_allW.1 <- r1_allL.1 %>% spread(key=type, value = r)
# r1_allW.1 %>% dplyr::filter(netLabel == "all_net") %>% kable(digits=2)
# r1_allL.1 %>% filter(sn == 2) %>%  spread(key=type, value = r)

# summary table: grand mean
r1_allG <- r1_allL.1 %>% group_by(netLabel, type) %>%
  dplyr::summarise(r.m = mean(r), r.sd = sd(r)) %>%
  ungroup()
## `summarise()` has grouped output by 'netLabel'. You can override using the `.groups` argument.
r1_allG$r.se <- Rmisc::summarySEwithin(data = r1_allL.1, measurevar = "r", 
                                       idvar = "sn", withinvars = c("netLabel","type"))$se
r1_allG$r.ci <- Rmisc::summarySEwithin(data = r1_allL.1, measurevar = "r", 
                                       idvar = "sn", withinvars = c("netLabel","type"))$ci
r1_allG <- r1_allG %>% 
  mutate(lower.ci = r.m-r.ci,
         upper.ci = r.m+r.ci,
         lower.se = r.m-r.se,
         upper.se = r.m+r.se)

r1_allG %>% dplyr::select(netLabel, type, r.m) %>%
  spread(key=type, value=r.m) %>% kable(digits=2)
netLabel self other
All 0.49 0.46
Vis 0.72 0.71
SM 0.69 0.67
FPN 0.55 0.52
VAN 0.56 0.52
DAN 0.63 0.63
DMN 0.54 0.52
Limb 0.41 0.36
TP 0.02 0.03
SubCor 0.67 0.65


within 영상, between 영상 간 패턴 유사성을 요약하였다.


r1_allL <- r1_1 %>% group_by(sn, netNum, type) %>%
  dplyr::summarise(r=mean(r_type)) %>%
  ungroup()
## `summarise()` has grouped output by 'sn', 'netNum'. You can override using the `.groups` argument.
# r1_allL %>% kable(digits=2)

# subject-level, wide format
r1_allW <- r1_allL %>% spread(key=type, value = r)
r1_allL.1 <- r1_allW %>% mutate(self = (self12),
                                other = (other12+other21)/2) %>% 
  dplyr::select(sn, netNum, self, other) %>% 
  gather(key = type, value = r, self:other, factor_key = T)
r1_allW.1 <- r1_allL.1 %>% spread(key=type, value = r)
# r1_allL.1 %>% filter(netNum == 0) %>%  spread(key=type, value = r)

# summary table: grand mean
r1_allG <- r1_allL.1 %>% group_by(netNum, type) %>%
  dplyr::summarise(r.m = mean(r), r.sd = sd(r)) %>%
  ungroup()
## `summarise()` has grouped output by 'netNum'. You can override using the `.groups` argument.
r1_allG$r.se <- Rmisc::summarySEwithin(data = r1_allL.1, measurevar = "r", 
                                       idvar = "sn", withinvars = c("netNum","type"))$se
r1_allG$r.ci <- Rmisc::summarySEwithin(data = r1_allL.1, measurevar = "r", 
                                       idvar = "sn", withinvars = c("netNum","type"))$ci
r1_allG <- r1_allG %>% 
  mutate(lower.ci = r.m-r.ci,
         upper.ci = r.m+r.ci,
         lower.se = r.m-r.se,
         upper.se = r.m+r.se)

# plot 1
targNet = c(0)
r1_allL.p1 <- r1_allL.1 %>% filter(netNum %in% targNet)
r1_allW.p1 <- r1_allW.1 %>% filter(netNum %in% targNet)
r1_allG.p1 <- r1_allG %>% filter(netNum %in% targNet)

r1.p1.all.plot1 <- ggplot(data=r1_allL.p1, aes(x=type, y=r, fill=type, shpae=type)) +
  stat_summary(fun = mean, geom = "bar", position="dodge", 
               na.rm = TRUE, alpha = .9, width = 0.8,  color="black", size = 0.15) +
  # geom_hline(yintercept=0, linetype='solid', color='black', alpha =1, size=1) +
  facet_grid(.~netNum, scales="free_x", space = "free",
             labeller = labeller(netNum = c("0" = "All",
                                            "1" = "Vis",
                                            "2" = "SM",
                                            "3" = "Cont",
                                            "4" = "sal/VAtt",
                                            "5" = "DAN",
                                            "6" = "DMN",
                                            "7" = "Limb",
                                            "8" = "TP",
                                            "9" = "SubCor"))) +
  geom_point(data=r1_allL.p1, aes(x=type, y=r, fill=type), position = position_dodge(width=0.8),
             size=2, show.legend=F, color="gray90") +
  geom_segment(data=filter(r1_allW.p1), inherit.aes = FALSE,
               aes(x=1, y=filter(r1_allW.p1)$self,
                   xend=2, yend=filter(r1_allW.p1)$other),
               color="gray90") +
  geom_errorbar(data=r1_allG.p1, aes(x=type, y= r.m, ymin=r.m-r.ci, ymax=r.m+r.ci), width=.2,
                position=position_dodge(.8), color = "black") +
  scale_x_discrete(labels=c("Within Stim", "Others")) +
  scale_fill_manual(values = c("#F17402", "#2C57AA"), # c("#F17402", "#2C57AA"), c("#feb24c", "#91bfdb")
                    labels = c("Within Stim", "Others")) +
  scale_color_manual(values = c("#F17402", "#2C57AA"), # c("#F17402", "#2C57AA"), c("#feb24c", "#91bfdb")
                     labels = c("Within Stim", "Others")) +
  coord_cartesian(ylim = c(-0.2, 0.7), clip = "on") +
  labs(x = "Type", y = "Functional Connectivity (FC)") +
  ggtitle("FC - Yeo122net RSA") +
  theme_bw(base_size = 18) +
  theme(#axis.text.x=element_blank(),
    #axis.ticks.x=element_blank(),
    axis.title = element_text(face = "bold", size = 16, color = "black"),
    axis.text = element_text(face = "plain", hjust = 0.5, size = 15, color = "black"),
    axis.line=element_line(),
    strip.text.x = element_text(face = "plain", size = 15, color = "black"),
    strip.background = element_blank(),
    panel.grid.major = element_blank(),
    panel.grid.minor = element_blank(),
    panel.border = element_blank(),
    panel.spacing=unit(1, "lines"),
    plot.margin = margin(1, 0.3, 1, 0.3, "cm"), 
    legend.title = element_blank(),
    legend.position="bottom")
# ggsave("fig1_1.fmri.jpg", plot = r3.p1.all.plot1, width=6, height=6, unit='in', dpi=600)
r1.p1.all.plot1


# plot 2
targNet = c(1, 2, 3, 4, 5, 6, 7, 8, 9)
r1_allL.p2 <- r1_allL.1 %>% filter(netNum %in% targNet)
r1_allW.p2 <- r1_allW.1 %>% filter(netNum %in% targNet)
r1_allG.p2 <- r1_allG %>% filter(netNum %in% targNet)

r1.p1.all.plot2 <- ggplot(data=r1_allL.p2, aes(x=type, y=r, fill=type, shpae=type)) +
  stat_summary(fun = mean, geom = "bar", position="dodge", 
               na.rm = TRUE, alpha = .9, width = 0.8,  color="black", size = 0.15) +
  geom_hline(yintercept=0, linetype='solid', color='black', alpha =1, size=1) +
  facet_grid(.~netNum, scales="free_x", space = "free",
             labeller = labeller(netNum = c("0" = "All",
                                            "1" = "Vis",
                                            "2" = "SM",
                                            "3" = "Cont",
                                            "4" = "sal/VAtt",
                                            "5" = "DAN",
                                            "6" = "DMN",
                                            "7" = "Limb",
                                            "8" = "TP",
                                            "9" = "SubCor"))) +
  geom_point(data=r1_allL.p2, aes(x=type, y=r, fill=type), position = position_dodge(width=0.8),
             size=2, show.legend=F, color="gray90") +
  geom_segment(data=filter(r1_allW.p2), inherit.aes = FALSE,
               aes(x=1, y=filter(r1_allW.p2)$self,
                   xend=2, yend=filter(r1_allW.p2)$other),
               color="gray90") +
  geom_errorbar(data=r1_allG.p2, aes(x=type, y= r.m, ymin=r.m-r.ci, ymax=r.m+r.ci), width=.2,
                position=position_dodge(.8), color = "black") +
  scale_x_discrete(labels=c("Within Stim", "Others")) +
  scale_fill_manual(values = c("#F17402", "#2C57AA"), # c("#F17402", "#2C57AA"), c("#feb24c", "#91bfdb")
                    labels = c("Within Stim", "Others")) +
  scale_color_manual(values = c("#F17402", "#2C57AA"), # c("#F17402", "#2C57AA"), c("#feb24c", "#91bfdb")
                     labels = c("Within Stim", "Others")) +
  coord_cartesian(ylim = c(-0.5, 1), clip = "on") +
  labs(x = "Type", y = "Functional Connectivity (FC)") +
  ggtitle("FC - Yeo122net RSA") +
  theme_bw(base_size = 18) +
  theme(axis.text.x=element_blank(),
        axis.ticks.x=element_blank(),
        axis.title = element_text(face = "bold", size = 16, color = "black"),
        axis.text = element_text(face = "plain", hjust = 0.5, size = 15, color = "black"),
        axis.line=element_line(),
        strip.text.x = element_text(face = "plain", size = 15, color = "black"),
        strip.background = element_blank(),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.border = element_blank(),
        panel.spacing=unit(1, "lines"),
        plot.margin = margin(1, 0.3, 1, 0.3, "cm"), 
        legend.title = element_blank(),
        legend.position="bottom")
# plot-control 3
# ggsave("fig1_1.fmri.jpg", plot = r3.p1.all.plot1, width=6, height=6, unit='in', dpi=600)
r1.p1.all.plot2


전체 네트워크에서 within 영상, between 영상 간 패턴 유사성이 유의한 차이를 보이는지 확인하였다.


r1_allL.1.tmp <- r1_allL.1 %>% filter(netNum == 0)

r1.aov1.tmp <- aov_ez(id="sn", dv="r", data = r1_allL.1.tmp, within = c("type"))
# summary(r1.aov1)
nice(r1.aov1.tmp, es="pes") %>% kable(digits=2)
Effect df MSE F pes p.value
type 1, 19 0.00 34.80 *** .647 <.001

p_h1 <- r1_allL.1.tmp %>% 
  rstatix::pairwise_t_test(r ~ type, 
                           p.adjust.method="holm", 
                           paired=T, detailed=T) %>% 
  dplyr::select(group1, group2, estimate, conf.low, conf.high, df, statistic, p.adj, p.adj.signif) 
p_h2 <- r1_allL.1.tmp %>% # group_by(rep) %>% 
  rstatix::cohens_d(r ~ type, paired=T, ci = F) %>% 
  dplyr::select(group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("group1", "group2")) %>% kable(digits=3)
group1 group2 estimate conf.low conf.high df statistic p.adj p.adj.signif effsize magnitude
self other 0.032 0.021 0.044 19 5.899 0 **** 1.319 large


6.3.2 RSA : Within Part vs Between Part


이어서 참가자 간에서 각 영상 간 전/후반부의 패턴 유사성을 확인한다. 구체적으로 여러 영상에 걸친 전/후반부 각각의 패턴 유사성을 Within으로 두고, 서로 다른 영상, 파트 간의 유사성을 Between으로 두어 통계 분석을 수행하였다. 먼저 요약치를 확인한다.


# subject-level, long format
r3_allL <- r1_3 %>% group_by(sn, netLabel, part) %>%
  dplyr::summarise(r=mean(r_part)) %>%
  ungroup()
## `summarise()` has grouped output by 'sn', 'netLabel'. You can override using the `.groups` argument.
# r3_allL %>% kable(digits=2)

# subject-level, wide format
r3_allW <- r3_allL %>% spread(key=part, value = r)
r3_allL.1 <- r3_allW %>% mutate(p1_self = p1_wn,
                                p2_self = p2_wn,
                                p1_other = (p1_2),
                                p2_other = (p2_1)) %>% 
  dplyr::select(sn, netLabel, p1_self, p2_self, p1_other, p2_other) %>% 
  gather(key = part, value = r, p1_self:p2_other, factor_key = T) %>% 
  separate(col = part,  sep="_", into =c('part','type'))

r3_allL.1$part <- factor(r3_allL.1$part)
r3_allL.1$type <- factor(r3_allL.1$type, levels = c('self','other'))
# r3_allL.1 %>% filter(sn == 2) %>%  spread(key=part, value = r)
r3_allL.1 %>% dplyr::filter(netLabel == "all_net") %>% 
  spread(key = part, value = r) %>% kable(digits=2)
sn netLabel type

# summary table: grand mean
r3_allG <- r3_allL.1 %>% group_by(netLabel, part, type) %>%
  dplyr::summarise(r.m = mean(r), r.sd = sd(r)) %>%
  ungroup()
## `summarise()` has grouped output by 'netLabel', 'part'. You can override using the `.groups` argument.
r3_allG$r.se <- Rmisc::summarySEwithin(data = r3_allL.1, measurevar = "r", 
                                       idvar = "sn", withinvars = c("netLabel","part","type"))$se
r3_allG$r.ci <- Rmisc::summarySEwithin(data = r3_allL.1, measurevar = "r", 
                                       idvar = "sn", withinvars = c("netLabel","part","type"))$ci
r3_allG <- r3_allG %>% 
  mutate(lower.ci = r.m-r.ci,
         upper.ci = r.m+r.ci,
         lower.se = r.m-r.se,
         upper.se = r.m+r.se)

r3_allG %>% dplyr::select(netLabel, part, type, r.m) %>%
  spread(key=type, value=r.m) %>% kable(digits=2)
netLabel part self other
All p1 0.46 0.45
All p2 0.49 0.47
Vis p1 0.72 0.69
Vis p2 0.71 0.73
SM p1 0.67 0.66
SM p2 0.69 0.68
FPN p1 0.53 0.51
FPN p2 0.55 0.53
VAN p1 0.51 0.51
VAN p2 0.56 0.53
DAN p1 0.61 0.62
DAN p2 0.66 0.64
DMN p1 0.50 0.50
DMN p2 0.56 0.54
Limb p1 0.35 0.36
Limb p2 0.41 0.36
TP p1 0.03 0.03
TP p2 0.03 0.03
SubCor p1 0.63 0.63
SubCor p2 0.68 0.67


# subject-level, long format
r3_allL <- r1_3 %>% group_by(sn, netNum, part) %>%
  dplyr::summarise(r=mean(r_part)) %>%
  ungroup()
## `summarise()` has grouped output by 'sn', 'netNum'. You can override using the `.groups` argument.
# r3_allL %>% kable(digits=2)

# subject-level, wide format
r3_allW <- r3_allL %>% spread(key=part, value = r)
r3_allL.1 <- r3_allW %>% mutate(p1_self = p1_wn,
                                p2_self = p2_wn,
                                p1_other = (p1_2),
                                p2_other = (p2_1)) %>% 
  dplyr::select(sn, netNum, p1_self, p2_self, p1_other, p2_other) %>% 
  gather(key = part, value = r, p1_self:p2_other, factor_key = T) %>% 
  separate(col = part,  sep="_", into =c('part','type'))

r3_allL.1$part <- factor(r3_allL.1$part)
r3_allL.1$type <- factor(r3_allL.1$type, levels = c('self','other'))

r3_allW.1 <- r3_allL.1 %>% spread(key=type, value = r)

# summary table: grand mean
r3_allG <- r3_allL.1 %>% group_by(netNum, part, type) %>%
  dplyr::summarise(r.m = mean(r), r.sd = sd(r)) %>%
  ungroup()
## `summarise()` has grouped output by 'netNum', 'part'. You can override using the `.groups` argument.
r3_allG$r.se <- Rmisc::summarySEwithin(data = r3_allL.1, measurevar = "r", 
                                       idvar = "sn", withinvars = c("netNum","part","type"))$se
r3_allG$r.ci <- Rmisc::summarySEwithin(data = r3_allL.1, measurevar = "r", 
                                       idvar = "sn", withinvars = c("netNum","part","type"))$ci
r3_allG <- r3_allG %>% 
  mutate(lower.ci = r.m-r.ci,
         upper.ci = r.m+r.ci,
         lower.se = r.m-r.se,
         upper.se = r.m+r.se)



# plot 1
targNet = c(0)
r3_allL.p1 <- r3_allL.1 %>% filter(netNum %in% targNet)
r3_allW.p1 <- r3_allW.1 %>% filter(netNum %in% targNet)
r3_allG.p1 <- r3_allG %>% filter(netNum %in% targNet)

r3.p1.all.plot1 <- ggplot(data=r3_allL.p1, aes(x=part, y=r, fill=type, shpae=type)) +
  stat_summary(fun = mean, geom = "bar", position="dodge", 
               na.rm = TRUE, alpha = .9, width = 0.8,  color="black", size = 0.15) +
  geom_hline(yintercept=0, linetype='solid', color='black', alpha =1, size=1) +
  facet_grid(.~netNum, scales="free_x", space = "free",
             labeller = labeller(netNum = c("0" = "All",
                                            "1" = "Vis",
                                            "2" = "SM",
                                            "3" = "Cont",
                                            "4" = "sal/VAtt",
                                            "5" = "DAN",
                                            "6" = "DMN",
                                            "7" = "Limb",
                                            "8" = "TP",
                                            "9" = "SubCor"))) +
  geom_point(data=r3_allL.p1, aes(x=part, y=r, fill=type), position = position_dodge(width=0.8),
             size=2, show.legend=F, color="gray90") +
  geom_segment(data=filter(r3_allW.p1, part == "p1"), inherit.aes = FALSE,
               aes(x=0.8, y=filter(r3_allW.p1, part == "p1")$self,
                   xend=1.2, yend=filter(r3_allW.p1, part == "p1")$other),
               color="gray90") +
  geom_segment(data=filter(r3_allW.p1, part == "p2"), inherit.aes = FALSE,
               aes(x=1.8, y=filter(r3_allW.p1, part == "p2")$self,
                   xend=2.2, yend=filter(r3_allW.p1, part == "p2")$other),
               color="gray90") +
  geom_errorbar(data=r3_allG.p1, aes(x=part, y= r.m, ymin=r.m-r.ci, ymax=r.m+r.ci), width=.2,
                position=position_dodge(.8), color = "black") +
  scale_x_discrete(labels=c("Part 1","Part 2")) +
  scale_fill_manual(values = c("#F17402", "#2C57AA"), # c("#F17402", "#2C57AA"), c("#feb24c", "#91bfdb")
                    labels = c("Within", "Between")) +
  scale_color_manual(values = c("#F17402", "#2C57AA"), # c("#F17402", "#2C57AA"), c("#feb24c", "#91bfdb")
                     labels = c("Within", "Between")) +
  coord_cartesian(ylim = c(-0.2, 0.7), clip = "on") +
  labs(x = "Part", y = "Functional Connectivity (FC)") +
  ggtitle("FC - Yeo122net RSA") +
  theme_bw(base_size = 18) +
  theme(#axis.text.x=element_blank(),
    #axis.ticks.x=element_blank(),
    axis.title = element_text(face = "bold", size = 16, color = "black"),
    axis.text = element_text(face = "plain", hjust = 0.5, size = 15, color = "black"),
    axis.line=element_line(),
    strip.text.x = element_text(face = "plain", size = 15, color = "black"),
    strip.background = element_blank(),
    panel.grid.major = element_blank(),
    panel.grid.minor = element_blank(),
    panel.border = element_blank(),
    panel.spacing=unit(1, "lines"),
    plot.margin = margin(1, 0.3, 1, 0.3, "cm"), 
    legend.title = element_blank(),
    legend.position="bottom")
# plot-control 3
# ggsave("fig1_1.fmri.jpg", plot = r3.p1.all.plot1, width=6, height=6, unit='in', dpi=600)
r3.p1.all.plot1


# plot 2
targNet = c(1, 2, 3, 4, 5, 6, 7, 8, 9)
r3_allL.p1 <- r3_allL.1 %>% filter(netNum %in% targNet)
r3_allW.p1 <- r3_allW.1 %>% filter(netNum %in% targNet)
r3_allG.p1 <- r3_allG %>% filter(netNum %in% targNet)

r3.p1.all.plot2 <- ggplot(data=r3_allL.p1, aes(x=part, y=r, fill=type, shpae=type)) +
  stat_summary(fun = mean, geom = "bar", position="dodge", 
               na.rm = TRUE, alpha = .9, width = 0.8,  color="black", size = 0.15) +
  geom_hline(yintercept=0, linetype='solid', color='black', alpha =1, size=1) +
  facet_grid(.~netNum, scales="free_x", space = "free",
             labeller = labeller(netNum = c("0" = "All",
                                            "1" = "Vis",
                                            "2" = "SM",
                                            "3" = "Cont",
                                            "4" = "sal/VAtt",
                                            "5" = "DAN",
                                            "6" = "DMN",
                                            "7" = "Limb",
                                            "8" = "TP",
                                            "9" = "SubCor"))) +
  geom_point(data=r3_allL.p1, aes(x=part, y=r, fill=type), position = position_dodge(width=0.8),
             size=2, show.legend=F, color="gray90") +
  geom_segment(data=filter(r3_allW.p1, part == "p1"), inherit.aes = FALSE,
               aes(x=0.8, y=filter(r3_allW.p1, part == "p1")$self,
                   xend=1.2, yend=filter(r3_allW.p1, part == "p1")$other),
               color="gray90") +
  geom_segment(data=filter(r3_allW.p1, part == "p2"), inherit.aes = FALSE,
               aes(x=1.8, y=filter(r3_allW.p1, part == "p2")$self,
                   xend=2.2, yend=filter(r3_allW.p1, part == "p2")$other),
               color="gray90") +
  geom_errorbar(data=r3_allG.p1, aes(x=part, y= r.m, ymin=r.m-r.ci, ymax=r.m+r.ci), width=.2,
                position=position_dodge(.8), color = "black") +
  scale_x_discrete(labels=c("Part 1","Part 2")) +
  scale_fill_manual(values = c("#F17402", "#2C57AA"), # c("#F17402", "#2C57AA"), c("#feb24c", "#91bfdb")
                    labels = c("Within", "Between")) +
  scale_color_manual(values = c("#F17402", "#2C57AA"), # c("#F17402", "#2C57AA"), c("#feb24c", "#91bfdb")
                     labels = c("Within", "Between")) +
  
  # coord_cartesian(ylim = c(-0.2, 0.7), clip = "on") +
  labs(x = "Part", y = "Functional Connectivity (FC)") +
  ggtitle("FC - Yeo122net RSA") +
  theme_bw(base_size = 18) +
  theme(#axis.text.x=element_blank(),
    #axis.ticks.x=element_blank(),
    axis.title = element_text(face = "bold", size = 16, color = "black"),
    axis.text = element_text(face = "plain", hjust = 0.5, size = 15, color = "black"),
    axis.line=element_line(),
    strip.text.x = element_text(face = "plain", size = 15, color = "black"),
    strip.background = element_blank(),
    panel.grid.major = element_blank(),
    panel.grid.minor = element_blank(),
    panel.border = element_blank(),
    panel.spacing=unit(1, "lines"),
    plot.margin = margin(1, 0.3, 1, 0.3, "cm"), 
    legend.title = element_blank(),
    legend.position="bottom")
# ggsave("fig1_1.fmri.jpg", plot = r3.p1.all.plot1, width=6, height=6, unit='in', dpi=600)
r3.p1.all.plot2


각 구획 (전/후반부)과 유형 (Within(Self), Between(Other))을 요인으로 통계 분석을 수행하였다.


r3_allL.1.tmp <- r3_allL.1 %>% filter(netNum == 0)

r3.aov1.tmp <- aov_ez(id="sn", dv="r", data = r3_allL.1.tmp, within = c("part","type"))
# summary(r1.aov1)
nice(r3.aov1.tmp, es="pes") %>% kable(digits=2)
Effect df MSE F pes p.value
part 1, 19 0.00 17.54 *** .480 <.001
type 1, 19 0.00 59.43 *** .758 <.001
part:type 1, 19 0.00 2.47 .115 .133
p_h1 <- r3_allL.1.tmp %>% group_by(part) %>% 
  rstatix::pairwise_t_test(r ~ type, 
                           p.adjust.method="holm", 
                           paired=T, detailed=T) %>% 
  dplyr::select(part, group1, group2, estimate, conf.low, conf.high, df, statistic, p.adj, p.adj.signif) 
p_h2 <- r3_allL.1.tmp %>% group_by(part) %>% 
  rstatix::cohens_d(r ~ type, paired=T, ci = F) %>% 
  dplyr::select(part, group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("part","group1", "group2")) %>% kable(digits=3)
part group1 group2 estimate conf.low conf.high df statistic p.adj p.adj.signif effsize magnitude
p1 self other 0.011 0.002 0.020 19 2.453 0.024 * 0.549 moderate
p2 self other 0.020 0.015 0.025 19 8.981 0.000 **** 2.008 large
p_h1 <- r3_allL.1.tmp %>% group_by(type) %>% 
  rstatix::pairwise_t_test(r ~ part, 
                           p.adjust.method="holm", 
                           paired=T, detailed=T) %>% 
  dplyr::select(type, group1, group2, estimate, conf.low, conf.high, df, statistic, p.adj, p.adj.signif) 
p_h2 <- r3_allL.1.tmp %>% group_by(type) %>% 
  rstatix::cohens_d(r ~ part, paired=T, ci = F) %>% 
  dplyr::select(type, group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("type","group1", "group2")) %>% kable(digits=3)
type group1 group2 estimate conf.low conf.high df statistic p.adj p.adj.signif effsize magnitude
other p1 p2 -0.024 -0.035 -0.013 19 -4.614 0.000 *** -1.032 large
self p1 p2 -0.033 -0.052 -0.014 19 -3.636 0.002 ** -0.813 large


r3_allL.1.tmp <- r3_allL.1# %>% filter(netNum == 0)

r3.aov1.tmp <- aov_ez(id="sn", dv="r", data = r3_allL.1.tmp, within = c("netNum","part","type"))
# summary(r1.aov1)
nice(r3.aov1.tmp, es="pes") %>% kable(digits=2)
Effect df MSE F pes p.value
netNum 3.34, 63.55 0.05 163.12 *** .896 <.001
part 1, 19 0.01 20.99 *** .525 <.001
type 1, 19 0.00 42.46 *** .691 <.001
netNum:part 3.09, 58.76 0.01 1.29 .063 .288
netNum:type 2.37, 45.10 0.00 1.79 .086 .173
part:type 1, 19 0.00 4.78 * .201 .042
netNum:part:type 2.68, 50.95 0.00 5.09 ** .211 .005
p_h1 <- r3_allL.1.tmp %>% group_by(netNum, part) %>% 
  rstatix::pairwise_t_test(r ~ type, 
                           p.adjust.method="holm", 
                           paired=T, detailed=T) %>% 
  dplyr::select(netNum, part, group1, group2, estimate, conf.low, conf.high, df, statistic, p.adj, p.adj.signif) 
p_h2 <- r3_allL.1.tmp %>% group_by(netNum, part) %>% 
  rstatix::cohens_d(r ~ type, paired=T, ci = F) %>% 
  dplyr::select(netNum, part, group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("netNum","part","group1", "group2")) %>% kable(digits=3)
netNum part group1 group2 estimate conf.low conf.high df statistic p.adj p.adj.signif effsize magnitude
0 p1 self other 0.011 0.002 0.020 19 2.453 0.024 * 0.549 moderate
0 p2 self other 0.020 0.015 0.025 19 8.981 0.000 **** 2.008 large
1 p1 self other 0.031 0.019 0.044 19 5.440 0.000 **** 1.216 large
1 p2 self other -0.019 -0.030 -0.008 19 -3.475 0.003 ** -0.777 moderate
2 p1 self other 0.006 -0.004 0.017 19 1.342 0.195 ns 0.300 small
2 p2 self other 0.009 0.001 0.017 19 2.316 0.032 * 0.518 moderate
3 p1 self other 0.015 0.003 0.027 19 2.657 0.016 * 0.594 moderate
3 p2 self other 0.024 0.018 0.031 19 7.608 0.000 **** 1.701 large
4 p1 self other 0.001 -0.008 0.009 19 0.166 0.870 ns 0.037 negligible
4 p2 self other 0.026 0.018 0.034 19 7.043 0.000 **** 1.575 large
5 p1 self other -0.005 -0.015 0.005 19 -1.069 0.299 ns -0.239 small
5 p2 self other 0.019 0.010 0.029 19 4.219 0.000 *** 0.943 large
6 p1 self other 0.001 -0.008 0.009 19 0.147 0.884 ns 0.033 negligible
6 p2 self other 0.025 0.019 0.032 19 7.927 0.000 **** 1.773 large
7 p1 self other -0.012 -0.042 0.019 19 -0.796 0.436 ns -0.178 negligible
7 p2 self other 0.040 0.005 0.075 19 2.420 0.026 * 0.541 moderate
8 p1 self other 0.003 -0.019 0.026 19 0.296 0.770 ns 0.066 negligible
8 p2 self other 0.007 -0.015 0.029 19 0.697 0.494 ns 0.156 negligible
9 p1 self other 0.003 -0.009 0.016 19 0.511 0.615 ns 0.114 negligible
9 p2 self other 0.007 -0.003 0.016 19 1.490 0.153 ns 0.333 small
p_h1 <- r3_allL.1.tmp %>% group_by(netNum, type) %>% 
  rstatix::pairwise_t_test(r ~ part, 
                           p.adjust.method="holm", 
                           paired=T, detailed=T) %>% 
  dplyr::select(netNum, type, group1, group2, estimate, conf.low, conf.high, df, statistic, p.adj, p.adj.signif) 
p_h2 <- r3_allL.1.tmp %>% group_by(netNum, type) %>% 
  rstatix::cohens_d(r ~ part, paired=T, ci = F) %>% 
  dplyr::select(netNum, type, group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("netNum","type","group1", "group2")) %>% kable(digits=3)
netNum type group1 group2 estimate conf.low conf.high df statistic p.adj p.adj.signif effsize magnitude
0 other p1 p2 -0.024 -0.035 -0.013 19 -4.614 0.000 *** -1.032 large
0 self p1 p2 -0.033 -0.052 -0.014 19 -3.636 0.002 ** -0.813 large
1 other p1 p2 -0.040 -0.054 -0.026 19 -6.009 0.000 **** -1.344 large
1 self p1 p2 0.010 -0.019 0.040 19 0.729 0.475 ns 0.163 negligible
2 other p1 p2 -0.016 -0.031 -0.001 19 -2.246 0.037 * -0.502 moderate
2 self p1 p2 -0.018 -0.037 0.000 19 -2.043 0.055 ns -0.457 small
3 other p1 p2 -0.018 -0.032 -0.004 19 -2.760 0.013 * -0.617 moderate
3 self p1 p2 -0.027 -0.045 -0.010 19 -3.316 0.004 ** -0.741 moderate
4 other p1 p2 -0.020 -0.034 -0.006 19 -2.926 0.009 ** -0.654 moderate
4 self p1 p2 -0.046 -0.065 -0.027 19 -5.093 0.000 **** -1.139 large
5 other p1 p2 -0.018 -0.034 -0.003 19 -2.482 0.023 * -0.555 moderate
5 self p1 p2 -0.043 -0.066 -0.019 19 -3.798 0.001 ** -0.849 large
6 other p1 p2 -0.033 -0.048 -0.017 19 -4.443 0.000 *** -0.993 large
6 self p1 p2 -0.057 -0.078 -0.037 19 -5.918 0.000 **** -1.323 large
7 other p1 p2 0.000 -0.060 0.060 19 -0.002 0.998 ns 0.000 negligible
7 self p1 p2 -0.052 -0.116 0.012 19 -1.693 0.107 ns -0.379 small
8 other p1 p2 -0.001 -0.028 0.027 19 -0.065 0.949 ns -0.015 negligible
8 self p1 p2 -0.005 -0.042 0.032 19 -0.282 0.781 ns -0.063 negligible
9 other p1 p2 -0.041 -0.063 -0.020 19 -4.077 0.001 *** -0.912 large
9 self p1 p2 -0.045 -0.080 -0.009 19 -2.643 0.016 * -0.591 moderate


6.3.3 RSA - Difference : Within Part vs Between Part


보조적인 분석으로 Within-Between의 차이가 파트별로 유의하게 다른지를 살펴본다.


# subject-level, long format
r4_allL <- r1_3 %>% group_by(sn, netLabel, part) %>%
  dplyr::summarise(r=mean(r_part)) %>%
  ungroup()
## `summarise()` has grouped output by 'sn', 'netLabel'. You can override using the `.groups` argument.
# r4_allL %>% kable(digits=2)

# subject-level, wide format
r4_allW <- r4_allL %>% spread(key=part, value = r)
r4_allL.1 <- r4_allW %>% mutate(p1_self = p1_wn,
                                p2_self = p2_wn,
                                p1_other = (p1_2),
                                p2_other = (p2_1)) %>% 
  dplyr::select(sn, netLabel, p1_self, p2_self, p1_other, p2_other) %>% 
  gather(key = part, value = r, p1_self:p2_other, factor_key = T) %>% 
  separate(col = part,  sep="_", into =c('part','type'))

r4_allL.1$part <- factor(r4_allL.1$part)
r4_allL.1$type <- factor(r4_allL.1$type, levels = c('self','other'))

r4_allL.2 <- r4_allL.1 %>% spread(key = type, value = r) %>% mutate(r = self - other) %>% 
  dplyr::select(sn, netLabel, part, r)
# r4_allL.1 %>% filter(sn == 2) %>%  spread(key=part, value = r)
# r4_allL.1 %>% dplyr::filter(netLabel == "all_net") %>% 
#   spread(key = part, value = r) %>% kable(digits=2)

# summary table: grand mean
r4_allG <- r4_allL.2 %>% group_by(netLabel, part) %>%
  dplyr::summarise(r.m = mean(r), r.sd = sd(r)) %>%
  ungroup()
## `summarise()` has grouped output by 'netLabel'. You can override using the `.groups` argument.
r4_allG$r.se <- Rmisc::summarySEwithin(data = r4_allL.2, measurevar = "r", 
                                       idvar = "sn", withinvars = c("netLabel","part"))$se
r4_allG$r.ci <- Rmisc::summarySEwithin(data = r4_allL.2, measurevar = "r", 
                                       idvar = "sn", withinvars = c("netLabel","part"))$ci
r4_allG <- r4_allG %>% 
  mutate(lower.ci = r.m-r.ci,
         upper.ci = r.m+r.ci,
         lower.se = r.m-r.se,
         upper.se = r.m+r.se)

r4_allG %>% dplyr::select(netLabel, part, r.m) %>%
  spread(key=part, value=r.m) %>% kable(digits=2)
netLabel p1 p2
All 0.01 0.02
Vis 0.03 -0.02
SM 0.01 0.01
FPN 0.02 0.02
VAN 0.00 0.03
DAN 0.00 0.02
DMN 0.00 0.03
Limb -0.01 0.04
TP 0.00 0.01
SubCor 0.00 0.01


# subject-level, long format
r4_allL <- r1_3 %>% group_by(sn, netNum, part) %>%
  dplyr::summarise(r=mean(r_part)) %>%
  ungroup()
## `summarise()` has grouped output by 'sn', 'netNum'. You can override using the `.groups` argument.
# r4_allL %>% kable(digits=2)

# subject-level, wide format
r4_allW <- r4_allL %>% spread(key=part, value = r)
r4_allL.1 <- r4_allW %>% mutate(p1_self = p1_wn,
                                p2_self = p2_wn,
                                
                                p1_other = (p1_2),
                                p2_other = (p2_1)) %>% 
  dplyr::select(sn, netNum, p1_self, p2_self, p1_other, p2_other) %>% 
  gather(key = part, value = r, p1_self:p2_other, factor_key = T) %>% 
  separate(col = part,  sep="_", into =c('part','type'))

r4_allL.1$part <- factor(r4_allL.1$part)
r4_allL.1$type <- factor(r4_allL.1$type, levels = c('self','other'))

r4_allL.2 <- r4_allL.1 %>% spread(key = type, value = r) %>% mutate(r = self - other) %>% 
  dplyr::select(sn, netNum, part, r)

r4_allW.2 <- r4_allL.2 %>% spread(key = part, value = r)

# summary table: grand mean
r4_allG <- r4_allL.2 %>% group_by(netNum, part) %>%
  dplyr::summarise(r.m = mean(r), r.sd = sd(r)) %>%
  ungroup()
## `summarise()` has grouped output by 'netNum'. You can override using the `.groups` argument.
r4_allG$r.se <- Rmisc::summarySEwithin(data = r4_allL.2, measurevar = "r", 
                                       idvar = "sn", withinvars = c("netNum","part"))$se
r4_allG$r.ci <- Rmisc::summarySEwithin(data = r4_allL.2, measurevar = "r", 
                                       idvar = "sn", withinvars = c("netNum","part"))$ci
r4_allG <- r4_allG %>% 
  mutate(lower.ci = r.m-r.ci,
         upper.ci = r.m+r.ci,
         lower.se = r.m-r.se,
         upper.se = r.m+r.se)

# all_net
# 1. central visual
# 2. control A
# 3. control B
# 4. control C
# 5. default A
# 6. default B
# 7. default C
# 8. dorsal attention A
# 9. dorsal attention B
# 10. limbic A
# 11. limbic B
# 12. peripheral visual
# 13. salience / ventral attention A
# 14. salience / ventral attention B
# 15. somatomotor A
# 16. somatomotor B
# 17. temporal parietal
# 18. subCor

# plot 1
targNet = c(0)
r4_allL.p1 <- r4_allL.2 %>% filter(netNum %in% targNet)
r4_allW.p1 <- r4_allW.2 %>% filter(netNum %in% targNet)
r4_allG.p1 <- r4_allG %>% filter(netNum %in% targNet)

r4.p1.all.plot1 <- ggplot(data=r4_allL.p1, aes(x=part, y=r, fill=part, shpae=part)) +
  stat_summary(fun = mean, geom = "bar", position="dodge", 
               na.rm = TRUE, alpha = .9, width = 0.8,  color="black", size = 0.15) +
  geom_hline(yintercept=0, linetype='solid', color='black', alpha =1, size=1) +
  facet_grid(.~netNum, scales="free_x", space = "free",
             labeller = labeller(netNum = c("0" = "All",
                                            "1" = "Vis",
                                            "2" = "SM",
                                            "3" = "Cont",
                                            "4" = "sal/VAtt",
                                            "5" = "DAN",
                                            "6" = "DMN",
                                            "7" = "Limb",
                                            "8" = "TP",
                                            "9" = "SubCor"))) +
  geom_point(data=r4_allL.p1, aes(x=part, y=r, fill=part), position = position_dodge(width=0.8),
             size=2, show.legend=F, color="gray90") +
  geom_segment(data=filter(r4_allW.p1), inherit.aes = FALSE,
               aes(x=1, y=filter(r4_allW.p1)$p1,
                   xend=2, yend=filter(r4_allW.p1)$p2),
               color="gray90") +
  geom_errorbar(data=r4_allG.p1, aes(x=part, y= r.m, ymin=r.m-r.ci, ymax=r.m+r.ci), width=.2,
                position=position_dodge(.8), color = "black") +
  scale_x_discrete(labels=c("Part 1","Part 2")) +
  scale_fill_brewer(palette="Set2", # c("#F17402", "#2C57AA"), c("#feb24c", "#91bfdb")
                    labels=c("Part 1","Part 2")) +
  scale_color_brewer(palette="Set2", # c("#F17402", "#2C57AA"), c("#feb24c", "#91bfdb")
                     labels=c("Part 1","Part 2")) +
  
  # coord_cartesian(ylim = c(-1, 1), clip = "on") +
  labs(x = "Part", y = "Difference btw Self & Other") +
  ggtitle("FC - Yeo122net RSA") +
  theme_bw(base_size = 18) +
  theme(axis.text.x=element_blank(),
        axis.ticks.x=element_blank(),
        axis.title = element_text(face = "bold", size = 16, color = "black"),
        axis.text = element_text(face = "plain", hjust = 0.5, size = 15, color = "black"),
        axis.line=element_line(),
        strip.text.x = element_text(face = "plain", size = 15, color = "black"),
        strip.background = element_blank(),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.border = element_blank(),
        panel.spacing=unit(1, "lines"),
        plot.margin = margin(1, 0.3, 1, 0.3, "cm"), 
        legend.title = element_blank(),
        legend.position="bottom")
# plot-control 3
# ggsave("fig1_1.fmri.jpg", plot = r4.p1.all.plot1, width=6, height=6, unit='in', dpi=600)
r4.p1.all.plot1


# all_net
# 1. central visual
# 2. control A
# 3. control B
# 4. control C
# 5. default A
# 6. default B
# 7. default C
# 8. dorsal attention A
# 9. dorsal attention B
# 10. limbic A
# 11. limbic B
# 12. peripheral visual
# 13. salience / ventral attention A
# 14. salience / ventral attention B
# 15. somatomotor A
# 16. somatomotor B
# 17. temporal parietal
# 18. subCor

# plot 2
targNet = c(1, 2, 3, 4, 5, 6, 7, 8, 9)
r4_allL.p1 <- r4_allL.2 %>% filter(netNum %in% targNet)
r4_allW.p1 <- r4_allW.2 %>% filter(netNum %in% targNet)
r4_allG.p1 <- r4_allG %>% filter(netNum %in% targNet)

r4.p1.all.plot2 <- ggplot(data=r4_allL.p1, aes(x=part, y=r, fill=part, shpae=part)) +
  stat_summary(fun = mean, geom = "bar", position="dodge", 
               na.rm = TRUE, alpha = .9, width = 0.8,  color="black", size = 0.15) +
  geom_hline(yintercept=0, linetype='solid', color='black', alpha =1, size=1) +
  facet_grid(.~netNum, scales="free_x", space = "free",
             labeller = labeller(netNum = c("0" = "All",
                                            "1" = "Vis",
                                            "2" = "SM",
                                            "3" = "Cont",
                                            "4" = "sal/VAtt",
                                            "5" = "DAN",
                                            "6" = "DMN",
                                            "7" = "Limb",
                                            "8" = "TP",
                                            "9" = "SubCor"))) +
  geom_point(data=r4_allL.p1, aes(x=part, y=r, fill=part), position = position_dodge(width=0.8),
             size=2, show.legend=F, color="gray90") +
  geom_segment(data=filter(r4_allW.p1), inherit.aes = FALSE,
               aes(x=1, y=filter(r4_allW.p1)$p1,
                   xend=2, yend=filter(r4_allW.p1)$p2),
               color="gray90") +
  geom_errorbar(data=r4_allG.p1, aes(x=part, y= r.m, ymin=r.m-r.ci, ymax=r.m+r.ci), width=.2,
                position=position_dodge(.8), color = "black") +
  scale_x_discrete(labels=c("Part 1","Part 2")) +
  scale_fill_brewer(palette="Set2", # c("#F17402", "#2C57AA"), c("#feb24c", "#91bfdb")
                    labels=c("Part 1","Part 2")) +
  scale_color_brewer(palette="Set2", # c("#F17402", "#2C57AA"), c("#feb24c", "#91bfdb")
                     labels=c("Part 1","Part 2")) +
  
  # coord_cartesian(ylim = c(-1, 1), clip = "on") +
  labs(x = "Part", y = "Difference btw Self & Other") +
  ggtitle("FC - Yeo122net RSA") +
  theme_bw(base_size = 18) +
  theme(#axis.text.x=element_blank(),
    #axis.ticks.x=element_blank(),
    axis.title = element_text(face = "bold", size = 16, color = "black"),
    axis.text = element_text(face = "plain", hjust = 0.5, size = 15, color = "black"),
    axis.line=element_line(),
    strip.text.x = element_text(face = "plain", size = 15, color = "black"),
    strip.background = element_blank(),
    panel.grid.major = element_blank(),
    panel.grid.minor = element_blank(),
    panel.border = element_blank(),
    panel.spacing=unit(1, "lines"),
    plot.margin = margin(1, 0.3, 1, 0.3, "cm"), 
    legend.title = element_blank(),
    legend.position="bottom")
# plot-control 3
# ggsave("fig1_1.fmri.jpg", plot = r4.p1.all.plot1, width=6, height=6, unit='in', dpi=600)
r4.p1.all.plot2


RM-ANOVA


r4_allL.1.tmp <- r4_allL.2 # %>% filter(netNum == 0)

r4.aov1.tmp <- aov_ez(id="sn", dv="r", data = r4_allL.1.tmp, within = c("netNum", "part"))
# summary(r1.aov1)
nice(r4.aov1.tmp, es="pes") %>% kable(digits=2)
Effect df MSE F pes p.value
netNum 2.37, 45.10 0.00 1.79 .086 .173
part 1, 19 0.00 4.78 * .201 .042
netNum:part 2.68, 50.95 0.00 5.09 ** .211 .005
p_h1 <- r4_allL.1.tmp %>% group_by(netNum) %>% 
  rstatix::pairwise_t_test(r ~ part, 
                           p.adjust.method="holm", 
                           paired=T, detailed=T) %>% 
  dplyr::select(netNum, group1, group2, estimate, conf.low, conf.high, df, statistic, p.adj, p.adj.signif) 
p_h2 <- r4_allL.1.tmp %>% group_by(netNum) %>% 
  rstatix::cohens_d(r ~ part, paired=T, ci = F) %>% 
  dplyr::select(netNum, group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("netNum","group1", "group2")) %>% kable(digits=3)
netNum group1 group2 estimate conf.low conf.high df statistic p.adj p.adj.signif effsize magnitude
0 p1 p2 -0.009 -0.021 0.003 19 -1.571 0.133 ns -0.351 small
1 p1 p2 0.050 0.027 0.073 19 4.603 0.000 *** 1.029 large
2 p1 p2 -0.002 -0.018 0.013 19 -0.327 0.747 ns -0.073 negligible
3 p1 p2 -0.009 -0.024 0.005 19 -1.325 0.201 ns -0.296 small
4 p1 p2 -0.026 -0.039 -0.013 19 -4.088 0.001 *** -0.914 large
5 p1 p2 -0.024 -0.042 -0.007 19 -2.939 0.008 ** -0.657 moderate
6 p1 p2 -0.025 -0.037 -0.013 19 -4.299 0.000 *** -0.961 large
7 p1 p2 -0.052 -0.108 0.004 19 -1.937 0.068 ns -0.433 small
8 p1 p2 -0.004 -0.037 0.029 19 -0.264 0.795 ns -0.059 negligible
9 p1 p2 -0.004 -0.023 0.016 19 -0.377 0.710 ns -0.084 negligible




6.4 Univariate Analysis - FC value


각 네트워크 별로 Edge, 즉 Functional connectivity의 강도 자체가 구획별 차이를 보이는지 분석하였다. Edge의 부호(positive/negative)를 구분하여 살펴본다.



## FC
r10 <- read.csv("py_output/sFC_net_v2.csv", header = T)
r10_l <- r10 %>% dplyr::filter(sn %in% targ_sn)
r10_l$sn = factor(r10_l$sn)
r10_l$net = factor(r10_l$net,
                   levels = c('All', 'Vis', 'SM', 'FPN',
                                'VAN', 'DAN', 'DMN', 'Limb', 'SubCor','TP'),
                     labels = c('All', 'Vis', 'SM', 'FPN',
                                'VAN', 'DAN', 'DMN', 'Limb', 'SubCor','TP'))
r10_l$idx = factor(r10_l$idx)
r10_l$part = factor(r10_l$part, 
                    levels = c(1,2),
                    labels = c('p1','p2'))


## Behavior
r10_behav <- read.csv("data/aniFCnet_behav.csv", header = T)
glimpse(r10_behav, width = 80)
## Rows: 630
## Columns: 7
## $ Idx         <int> 26, 21, 12, 22, 7, 6, 4, 30, 29, 14, 5, 10, 28, 17, 19, 15…
## $ num         <int> 26, 21, 12, 22, 7, 6, 4, 30, 29, 14, 5, 10, 28, 17, 19, 15…
## $ stimIdx     <int> 2, 9, 10, 13, 15, 24, 25, 33, 44, 49, 58, 62, 68, 74, 81, …
## $ sn          <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1…
## $ correctness <int> 1, 1, 0, 0, 1, 1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1…
## $ scores      <int> 9, 9, 1, 1, 7, 9, 9, 1, 1, 7, 8, 9, 6, 6, 8, 9, 9, 6, 9, 6…
## $ check       <int> 0, 0, 1, 1, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
r10_behav <- r10_behav %>% dplyr::filter(sn %in% targ_sn)
r10_behav$sn = factor(r10_behav$sn)
r10_behav$idx = factor(r10_behav$stimIdx)
r10_behav$corr = r10_behav$correctness
r10_behav <- r10_behav %>% dplyr::select(sn, idx, corr, scores, check)

r10_1 <- merge(r10_l, r10_behav, by = c("sn", "idx"))
r10_2 <- r10_1 %>% filter(corr == 1, check != 1)


6.4.1 Positive Connectivity by Net & Part


Positive FC 값에 대한 분석을 수행한다.



# subject-level, long format
r10_allL <- r10_2 %>% group_by(sn, net, part) %>%
  dplyr::summarise(r=mean(p_fc)) %>%
  ungroup()
## `summarise()` has grouped output by 'sn', 'net'. You can override using the `.groups` argument.

# summary table: grand mean
r10_allG <- r10_allL %>% group_by(net, part) %>%
  dplyr::summarise(r.m = mean(r), r.sd = sd(r)) %>%
  ungroup()
## `summarise()` has grouped output by 'net'. You can override using the `.groups` argument.

r10_allG$r.se <- Rmisc::summarySEwithin(data = r10_allL, measurevar = "r", 
                                        idvar = "sn", withinvars = c("net","part"))$se
r10_allG$r.ci <- Rmisc::summarySEwithin(data = r10_allL, measurevar = "r", 
                                        idvar = "sn", withinvars = c("net","part"))$ci
r10_allG <- r10_allG %>% 
  mutate(lower.ci = r.m-r.ci,
         upper.ci = r.m+r.ci,
         lower.se = r.m-r.se,
         upper.se = r.m+r.se)

r10_allG %>% dplyr::select(net, part, r.m) %>%
  spread(key=part, value=r.m) %>% kable(digits=2)
net p1 p2
All 0.13 0.12
Vis 0.45 0.37
SM 0.46 0.44
FPN 0.21 0.18
VAN 0.26 0.24
DAN 0.30 0.29
DMN 0.23 0.22
Limb 0.51 0.50
SubCor 0.29 0.28
TP 0.63 0.59


r10_allL.p1 <- r10_allL
r10_allG.p1 <- r10_allG

r10.p1.all.plot1 <- ggplot(data=r10_allL.p1, aes(x=part, y=r, fill=part, shpae=part)) +
  stat_summary(fun = mean, geom = "bar", position="dodge", 
               na.rm = TRUE, alpha = .9, width = 0.8,  color="black", size = 0.15) +
  facet_grid(.~net, scales="free_x", space = "free") +
  geom_hline(yintercept=0, linetype='solid', color='black', alpha =1, size=1) +
  geom_point(data=r10_allL.p1, aes(x=part, y=r, fill=part), position = position_dodge(width=0.8),
             size=2, show.legend=F, color="gray90") +
  geom_errorbar(data=r10_allG.p1, aes(x=part, y= r.m, ymin=r.m-r.ci, ymax=r.m+r.ci), width=.2,
                position=position_dodge(.8), color = "black") +
  # scale_x_discrete(labels=c("Within", "Between")) +
  scale_fill_manual(values = c("#ED7D31", "#5B9BD5"), # c("#ED7D31", "#5B9BD5", "#70AD47"),
                    labels = c("First Half", "Second Half")) +  scale_color_brewer(palette="Set2") + 
  # coord_cartesian(ylim = c(-0.4, 0.4), clip = "on") +
  labs(x = "Part", y = "Functional Connectivity (FC)") +
  ggtitle("mean FC") +
  theme_bw(base_size = 18) +
  theme(#axis.text.x=element_blank(),
    #axis.ticks.x=element_blank(),
    axis.title = element_text(face = "bold", size = 16, color = "black"),
    axis.text = element_text(face = "plain", hjust = 0.5, size = 15, color = "black"),
    axis.line=element_line(),
    strip.text.x = element_text(face = "plain", size = 15, color = "black"),
    strip.background = element_blank(),
    panel.grid.major = element_blank(),
    panel.grid.minor = element_blank(),
    panel.border = element_blank(),
    panel.spacing=unit(1, "lines"),
    plot.margin = margin(1, 0.3, 1, 0.3, "cm"), 
    legend.title = element_blank(),
    legend.position="bottom")
# ggsave("fig1_1.fmri.jpg", plot = r3.p1.all.plot1, width=6, height=6, unit='in', dpi=600)
r10.p1.all.plot1


통계 분석 결과는 아래와 같다.


r10_allL.1.tmp <- r10_allL

r10.aov1.tmp <- aov_ez(id="sn", dv="r", data = r10_allL.1.tmp, within = c("net","part"))
# summary(r10.aov1)
nice(r10.aov1.tmp, es="pes") %>% kable(digits=2)
Effect df MSE F pes p.value
net 3.17, 60.15 0.02 154.54 *** .891 <.001
part 1, 19 0.00 114.48 *** .858 <.001
net:part 2.95, 56.01 0.00 8.51 *** .309 <.001
p_h1 <- r10_allL.1.tmp %>% group_by(net) %>% 
  rstatix::pairwise_t_test(r ~ part, 
                           p.adjust.method="holm", 
                           paired=T, detailed=T) %>% 
  dplyr::select(net, group1, group2, estimate, conf.low, conf.high, df, statistic, p.adj, p.adj.signif) 
p_h2 <- r10_allL.1.tmp %>% group_by(net) %>% 
  rstatix::cohens_d(r ~ part, paired=T, ci = F) %>% 
  dplyr::select(net, group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("net", "group1", "group2")) %>% kable(digits=3)
net group1 group2 estimate conf.low conf.high df statistic p.adj p.adj.signif effsize magnitude
All p1 p2 0.012 0.010 0.013 19 15.712 0.000 **** 3.513 large
DAN p1 p2 0.004 -0.005 0.013 19 1.032 0.315 ns 0.231 small
DMN p1 p2 0.015 0.009 0.021 19 5.212 0.000 **** 1.165 large
FPN p1 p2 0.029 0.023 0.036 19 9.744 0.000 **** 2.179 large
Limb p1 p2 0.003 -0.014 0.021 19 0.426 0.675 ns 0.095 negligible
SM p1 p2 0.014 -0.008 0.035 19 1.328 0.200 ns 0.297 small
SubCor p1 p2 0.005 -0.006 0.016 19 0.906 0.376 ns 0.203 small
TP p1 p2 0.036 0.003 0.069 19 2.315 0.032 * 0.518 moderate
VAN p1 p2 0.025 0.016 0.034 19 5.820 0.000 **** 1.301 large
Vis p1 p2 0.075 0.062 0.087 19 12.318 0.000 **** 2.754 large
p_h1 <- r10_allL.1.tmp %>% group_by(part) %>% 
  rstatix::pairwise_t_test(r ~ net, 
                           p.adjust.method="holm", 
                           paired=T, detailed=T) %>% 
  dplyr::select(part, group1, group2, estimate, conf.low, conf.high, df, statistic, p.adj, p.adj.signif) 
p_h2 <- r10_allL.1.tmp %>% group_by(part) %>% 
  rstatix::cohens_d(r ~ net, paired=T, ci = F) %>% 
  dplyr::select(part, group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("part", "group1", "group2")) %>% kable(digits=3)
part group1 group2 estimate conf.low conf.high df statistic p.adj p.adj.signif effsize magnitude
p1 All DAN -0.166 -0.190 -0.142 19 -14.705 0.000 **** -3.288 large
p1 All DMN -0.101 -0.109 -0.093 19 -26.346 0.000 **** -5.891 large
p1 All FPN -0.081 -0.092 -0.070 19 -14.825 0.000 **** -3.315 large
p1 All Limb -0.375 -0.411 -0.339 19 -21.765 0.000 **** -4.867 large
p1 All SM -0.327 -0.362 -0.292 19 -19.612 0.000 **** -4.385 large
p1 All SubCor -0.159 -0.176 -0.141 19 -19.138 0.000 **** -4.279 large
p1 All TP -0.499 -0.568 -0.430 19 -15.136 0.000 **** -3.385 large
p1 All VAN -0.134 -0.149 -0.119 19 -19.087 0.000 **** -4.268 large
p1 All Vis -0.318 -0.342 -0.294 19 -27.552 0.000 **** -6.161 large
p1 DAN DMN 0.065 0.040 0.090 19 5.426 0.000 *** 1.213 large
p1 DAN Limb -0.209 -0.252 -0.165 19 -10.108 0.000 **** -2.260 large
p1 DAN SubCor 0.007 -0.024 0.039 19 0.499 1.000 ns 0.112 negligible
p1 DAN TP -0.333 -0.395 -0.272 19 -11.329 0.000 **** -2.533 large
p1 DMN Limb -0.274 -0.313 -0.235 19 -14.811 0.000 **** -3.312 large
p1 DMN SubCor -0.058 -0.075 -0.041 19 -7.098 0.000 **** -1.587 large
p1 DMN TP -0.399 -0.469 -0.328 19 -11.823 0.000 **** -2.644 large
p1 FPN DAN -0.085 -0.107 -0.064 19 -8.290 0.000 **** -1.854 large
p1 FPN DMN -0.020 -0.033 -0.007 19 -3.136 0.038 * -0.701 moderate
p1 FPN Limb -0.294 -0.334 -0.253 19 -15.284 0.000 **** -3.418 large
p1 FPN SubCor -0.078 -0.099 -0.056 19 -7.525 0.000 **** -1.683 large
p1 FPN TP -0.418 -0.481 -0.355 19 -13.870 0.000 **** -3.102 large
p1 FPN VAN -0.053 -0.067 -0.039 19 -7.735 0.000 **** -1.730 large
p1 Limb SubCor 0.216 0.184 0.248 19 13.982 0.000 **** 3.127 large
p1 Limb TP -0.125 -0.196 -0.054 19 -3.683 0.013 * -0.823 large
p1 SM DAN 0.161 0.120 0.202 19 8.278 0.000 **** 1.851 large
p1 SM DMN 0.226 0.192 0.261 19 13.798 0.000 **** 3.085 large
p1 SM FPN 0.246 0.213 0.279 19 15.632 0.000 **** 3.496 large
p1 SM Limb -0.048 -0.095 0.000 19 -2.103 0.196 ns -0.470 small
p1 SM SubCor 0.168 0.135 0.202 19 10.467 0.000 **** 2.340 large
p1 SM TP -0.172 -0.240 -0.105 19 -5.350 0.000 *** -1.196 large
p1 SM VAN 0.193 0.156 0.230 19 10.858 0.000 **** 2.428 large
p1 SubCor TP -0.341 -0.411 -0.271 19 -10.170 0.000 **** -2.274 large
p1 VAN DAN -0.032 -0.057 -0.008 19 -2.752 0.076 ns -0.615 moderate
p1 VAN DMN 0.033 0.018 0.048 19 4.565 0.002 ** 1.021 large
p1 VAN Limb -0.241 -0.281 -0.200 19 -12.486 0.000 **** -2.792 large
p1 VAN SubCor -0.025 -0.050 0.001 19 -2.019 0.196 ns -0.451 small
p1 VAN TP -0.365 -0.430 -0.301 19 -11.794 0.000 **** -2.637 large
p1 Vis DAN 0.152 0.125 0.178 19 11.962 0.000 **** 2.675 large
p1 Vis DMN 0.217 0.192 0.242 19 17.932 0.000 **** 4.010 large
p1 Vis FPN 0.237 0.214 0.260 19 21.685 0.000 **** 4.849 large
p1 Vis Limb -0.057 -0.103 -0.011 19 -2.569 0.094 ns -0.574 moderate
p1 Vis SM -0.009 -0.054 0.036 19 -0.435 1.000 ns -0.097 negligible
p1 Vis SubCor 0.159 0.125 0.193 19 9.774 0.000 **** 2.185 large
p1 Vis TP -0.182 -0.247 -0.116 19 -5.821 0.000 *** -1.302 large
p1 Vis VAN 0.184 0.160 0.207 19 16.268 0.000 **** 3.638 large
p2 All DAN -0.174 -0.196 -0.151 19 -16.363 0.000 **** -3.659 large
p2 All DMN -0.098 -0.105 -0.091 19 -28.463 0.000 **** -6.364 large
p2 All FPN -0.064 -0.073 -0.054 19 -14.323 0.000 **** -3.203 large
p2 All Limb -0.383 -0.419 -0.348 19 -22.588 0.000 **** -5.051 large
p2 All SM -0.325 -0.360 -0.290 19 -19.402 0.000 **** -4.338 large
p2 All SubCor -0.166 -0.184 -0.147 19 -18.796 0.000 **** -4.203 large
p2 All TP -0.475 -0.530 -0.420 19 -18.164 0.000 **** -4.062 large
p2 All VAN -0.121 -0.136 -0.105 19 -16.591 0.000 **** -3.710 large
p2 All Vis -0.255 -0.276 -0.234 19 -25.448 0.000 **** -5.690 large
p2 DAN DMN 0.076 0.054 0.097 19 7.235 0.000 **** 1.618 large
p2 DAN Limb -0.210 -0.249 -0.170 19 -11.190 0.000 **** -2.502 large
p2 DAN SubCor 0.008 -0.023 0.038 19 0.535 0.599 ns 0.120 negligible
p2 DAN TP -0.301 -0.353 -0.250 19 -12.243 0.000 **** -2.738 large
p2 DMN Limb -0.285 -0.322 -0.248 19 -16.269 0.000 **** -3.638 large
p2 DMN SubCor -0.068 -0.087 -0.049 19 -7.536 0.000 **** -1.685 large
p2 DMN TP -0.377 -0.432 -0.322 19 -14.296 0.000 **** -3.197 large
p2 FPN DAN -0.110 -0.129 -0.091 19 -12.079 0.000 **** -2.701 large
p2 FPN DMN -0.034 -0.044 -0.025 19 -7.660 0.000 **** -1.713 large
p2 FPN Limb -0.319 -0.358 -0.281 19 -17.304 0.000 **** -3.869 large
p2 FPN SubCor -0.102 -0.125 -0.079 19 -9.374 0.000 **** -2.096 large
p2 FPN TP -0.411 -0.462 -0.361 19 -16.986 0.000 **** -3.798 large
p2 FPN VAN -0.057 -0.071 -0.043 19 -8.477 0.000 **** -1.896 large
p2 Limb SubCor 0.217 0.184 0.250 19 13.748 0.000 **** 3.074 large
p2 Limb TP -0.092 -0.158 -0.026 19 -2.908 0.027 * -0.650 moderate
p2 SM DAN 0.152 0.112 0.191 19 8.068 0.000 **** 1.804 large
p2 SM DMN 0.227 0.194 0.260 19 14.489 0.000 **** 3.240 large
p2 SM FPN 0.262 0.228 0.296 19 16.156 0.000 **** 3.613 large
p2 SM Limb -0.058 -0.102 -0.013 19 -2.719 0.027 * -0.608 moderate
p2 SM SubCor 0.160 0.125 0.195 19 9.550 0.000 **** 2.136 large
p2 SM TP -0.150 -0.199 -0.100 19 -6.299 0.000 **** -1.408 large
p2 SM VAN 0.205 0.168 0.241 19 11.757 0.000 **** 2.629 large
p2 SubCor TP -0.309 -0.366 -0.253 19 -11.437 0.000 **** -2.557 large
p2 VAN DAN -0.053 -0.075 -0.031 19 -5.145 0.000 *** -1.150 large
p2 VAN DMN 0.023 0.007 0.038 19 3.134 0.022 * 0.701 moderate
p2 VAN Limb -0.262 -0.300 -0.225 19 -14.627 0.000 **** -3.271 large
p2 VAN SubCor -0.045 -0.070 -0.020 19 -3.783 0.008 ** -0.846 large
p2 VAN TP -0.354 -0.406 -0.303 19 -14.421 0.000 **** -3.225 large
p2 Vis DAN 0.081 0.055 0.108 19 6.461 0.000 **** 1.445 large
p2 Vis DMN 0.157 0.134 0.180 19 14.387 0.000 **** 3.217 large
p2 Vis FPN 0.191 0.173 0.210 19 21.693 0.000 **** 4.851 large
p2 Vis Limb -0.128 -0.172 -0.084 19 -6.120 0.000 **** -1.368 large
p2 Vis SM -0.070 -0.110 -0.031 19 -3.751 0.008 ** -0.839 large
p2 Vis SubCor 0.089 0.062 0.117 19 6.790 0.000 **** 1.518 large
p2 Vis TP -0.220 -0.274 -0.166 19 -8.546 0.000 **** -1.911 large
p2 Vis VAN 0.134 0.113 0.155 19 13.425 0.000 **** 3.002 large


6.4.2 Negative Connectivity by Net & Part


Negative FC에 대한 분석을 수행한다.



# subject-level, long format
r10_allL <- r10_2 %>% group_by(sn, net, part) %>%
  dplyr::summarise(r=mean(n_fc)) %>%
  ungroup()
## `summarise()` has grouped output by 'sn', 'net'. You can override using the `.groups` argument.

# summary table: grand mean
r10_allG <- r10_allL %>% group_by(net, part) %>%
  dplyr::summarise(r.m = mean(r), r.sd = sd(r)) %>%
  ungroup()
## `summarise()` has grouped output by 'net'. You can override using the `.groups` argument.

r10_allG$r.se <- Rmisc::summarySEwithin(data = r10_allL, measurevar = "r", 
                                        idvar = "sn", withinvars = c("net","part"))$se
r10_allG$r.ci <- Rmisc::summarySEwithin(data = r10_allL, measurevar = "r", 
                                        idvar = "sn", withinvars = c("net","part"))$ci
r10_allG <- r10_allG %>% 
  mutate(lower.ci = r.m-r.ci,
         upper.ci = r.m+r.ci,
         lower.se = r.m-r.se,
         upper.se = r.m+r.se)

r10_allG %>% dplyr::select(net, part, r.m) %>%
  spread(key=part, value=r.m) %>% kable(digits=2)
net p1 p2
All -0.11 -0.10
Vis -0.04 -0.04
SM -0.01 -0.01
FPN -0.06 -0.06
VAN -0.03 -0.03
DAN -0.04 -0.04
DMN -0.05 -0.05
Limb -0.01 -0.01
SubCor -0.04 -0.03
TP 0.00 0.00


r10_allL.p1 <- r10_allL
r10_allG.p1 <- r10_allG

r10.p1.all.plot1 <- ggplot(data=r10_allL.p1, aes(x=part, y=r, fill=part, shpae=part)) +
  stat_summary(fun = mean, geom = "bar", position="dodge", 
               na.rm = TRUE, alpha = .9, width = 0.8,  color="black", size = 0.15) +
  facet_grid(.~net, scales="free_x", space = "free") +
  geom_hline(yintercept=0, linetype='solid', color='black', alpha =1, size=1) +
  geom_point(data=r10_allL.p1, aes(x=part, y=r, fill=part), position = position_dodge(width=0.8),
             size=2, show.legend=F, color="gray90") +
  geom_errorbar(data=r10_allG.p1, aes(x=part, y= r.m, ymin=r.m-r.ci, ymax=r.m+r.ci), width=.2,
                position=position_dodge(.8), color = "black") +
  # scale_x_discrete(labels=c("Within", "Between")) +
  scale_fill_manual(values = c("#ED7D31", "#5B9BD5"), # c("#ED7D31", "#5B9BD5", "#70AD47"),
                    labels = c("First Half", "Second Half")) +  scale_color_brewer(palette="Set2") + 
  # coord_cartesian(ylim = c(-0.4, 0.4), clip = "on") +
  labs(x = "Part", y = "Functional Connectivity (FC)") +
  ggtitle("mean FC") +
  theme_bw(base_size = 18) +
  theme(#axis.text.x=element_blank(),
    #axis.ticks.x=element_blank(),
    axis.title = element_text(face = "bold", size = 16, color = "black"),
    axis.text = element_text(face = "plain", hjust = 0.5, size = 15, color = "black"),
    axis.line=element_line(),
    strip.text.x = element_text(face = "plain", size = 15, color = "black"),
    strip.background = element_blank(),
    panel.grid.major = element_blank(),
    panel.grid.minor = element_blank(),
    panel.border = element_blank(),
    panel.spacing=unit(1, "lines"),
    plot.margin = margin(1, 0.3, 1, 0.3, "cm"), 
    legend.title = element_blank(),
    legend.position="bottom")
# ggsave("fig1_1.fmri.jpg", plot = r3.p1.all.plot1, width=6, height=6, unit='in', dpi=600)
r10.p1.all.plot1


통계 분석 결과는 아래와 같다.


r10_allL.1.tmp <- r10_allL

r10.aov1.tmp <- aov_ez(id="sn", dv="r", data = r10_allL.1.tmp, within = c("net","part"))
# summary(r10.aov1)
nice(r10.aov1.tmp, es="pes") %>% kable(digits=2)
Effect df MSE F pes p.value
net 4.06, 77.07 0.00 118.41 *** .862 <.001
part 1, 19 0.00 50.72 *** .727 <.001
net:part 4.86, 92.35 0.00 4.72 *** .199 <.001
p_h1 <- r10_allL.1.tmp %>% group_by(net) %>% 
  rstatix::pairwise_t_test(r ~ part, 
                           p.adjust.method="holm", 
                           paired=T, detailed=T) %>% 
  dplyr::select(net, group1, group2, estimate, conf.low, conf.high, df, statistic, p.adj, p.adj.signif) 
p_h2 <- r10_allL.1.tmp %>% group_by(net) %>% 
  rstatix::cohens_d(r ~ part, paired=T, ci = F) %>% 
  dplyr::select(net, group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("net", "group1", "group2")) %>% kable(digits=3)
net group1 group2 estimate conf.low conf.high df statistic p.adj p.adj.signif effsize magnitude
All p1 p2 -0.009 -0.011 -0.007 19 -10.934 0.000 **** -2.445 large
DAN p1 p2 -0.005 -0.009 -0.002 19 -3.171 0.005 ** -0.709 moderate
DMN p1 p2 -0.003 -0.006 -0.001 19 -2.604 0.018 * -0.582 moderate
FPN p1 p2 -0.003 -0.006 0.001 19 -1.698 0.106 ns -0.380 small
Limb p1 p2 -0.005 -0.008 -0.001 19 -2.843 0.010 * -0.636 moderate
SM p1 p2 -0.001 -0.003 0.001 19 -1.322 0.202 ns -0.296 small
SubCor p1 p2 -0.011 -0.015 -0.006 19 -4.991 0.000 **** -1.116 large
TP p1 p2 -0.001 -0.003 0.001 19 -0.877 0.392 ns -0.196 negligible
VAN p1 p2 -0.001 -0.004 0.001 19 -1.031 0.316 ns -0.231 small
Vis p1 p2 0.000 -0.006 0.006 19 -0.005 0.996 ns -0.001 negligible
p_h1 <- r10_allL.1.tmp %>% group_by(part) %>% 
  rstatix::pairwise_t_test(r ~ net, 
                           p.adjust.method="holm", 
                           paired=T, detailed=T) %>% 
  dplyr::select(part, group1, group2, estimate, conf.low, conf.high, df, statistic, p.adj, p.adj.signif) 
p_h2 <- r10_allL.1.tmp %>% group_by(part) %>% 
  rstatix::cohens_d(r ~ net, paired=T, ci = F) %>% 
  dplyr::select(part, group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("part", "group1", "group2")) %>% kable(digits=3)
part group1 group2 estimate conf.low conf.high df statistic p.adj p.adj.signif effsize magnitude
p1 All DAN -0.068 -0.077 -0.059 19 -15.332 0.000 **** -3.428 large
p1 All DMN -0.056 -0.062 -0.051 19 -21.039 0.000 **** -4.704 large
p1 All FPN -0.045 -0.052 -0.038 19 -14.339 0.000 **** -3.206 large
p1 All Limb -0.097 -0.105 -0.089 19 -24.311 0.000 **** -5.436 large
p1 All SM -0.100 -0.105 -0.096 19 -50.924 0.000 **** -11.387 large
p1 All SubCor -0.067 -0.078 -0.056 19 -12.750 0.000 **** -2.851 large
p1 All TP -0.108 -0.111 -0.105 19 -68.011 0.000 **** -15.208 large
p1 All VAN -0.075 -0.079 -0.071 19 -40.635 0.000 **** -9.086 large
p1 All Vis -0.074 -0.084 -0.064 19 -16.005 0.000 **** -3.579 large
p1 DAN DMN 0.012 0.004 0.020 19 2.968 0.079 ns 0.664 moderate
p1 DAN Limb -0.029 -0.040 -0.018 19 -5.386 0.001 *** -1.204 large
p1 DAN SubCor 0.001 -0.014 0.016 19 0.141 1.000 ns 0.032 negligible
p1 DAN TP -0.040 -0.048 -0.033 19 -11.015 0.000 **** -2.463 large
p1 DMN Limb -0.041 -0.052 -0.030 19 -7.913 0.000 **** -1.769 large
p1 DMN SubCor -0.011 -0.022 0.001 19 -1.964 0.515 ns -0.439 small
p1 DMN TP -0.052 -0.056 -0.048 19 -27.800 0.000 **** -6.216 large
p1 FPN DAN -0.023 -0.033 -0.013 19 -4.752 0.002 ** -1.063 large
p1 FPN DMN -0.011 -0.018 -0.004 19 -3.394 0.040 * -0.759 moderate
p1 FPN Limb -0.052 -0.062 -0.042 19 -10.394 0.000 **** -2.324 large
p1 FPN SubCor -0.022 -0.036 -0.008 19 -3.319 0.043 * -0.742 moderate
p1 FPN TP -0.063 -0.069 -0.057 19 -20.993 0.000 **** -4.694 large
p1 FPN VAN -0.030 -0.038 -0.023 19 -8.261 0.000 **** -1.847 large
p1 Limb SubCor 0.030 0.015 0.045 19 4.299 0.006 ** 0.961 large
p1 Limb TP -0.011 -0.020 -0.002 19 -2.631 0.149 ns -0.588 moderate
p1 SM DAN 0.032 0.025 0.040 19 9.045 0.000 **** 2.023 large
p1 SM DMN 0.044 0.040 0.048 19 23.911 0.000 **** 5.347 large
p1 SM FPN 0.055 0.049 0.061 19 19.411 0.000 **** 4.340 large
p1 SM Limb 0.003 -0.006 0.013 19 0.770 1.000 ns 0.172 negligible
p1 SM SubCor 0.033 0.022 0.044 19 6.358 0.000 **** 1.422 large
p1 SM TP -0.008 -0.010 -0.005 19 -6.521 0.000 **** -1.458 large
p1 SM VAN 0.025 0.021 0.029 19 12.769 0.000 **** 2.855 large
p1 SubCor TP -0.041 -0.053 -0.030 19 -7.430 0.000 **** -1.661 large
p1 VAN DAN 0.007 -0.001 0.015 19 1.914 0.515 ns 0.428 small
p1 VAN DMN 0.019 0.014 0.025 19 7.429 0.000 **** 1.661 large
p1 VAN Limb -0.022 -0.030 -0.013 19 -5.398 0.001 *** -1.207 large
p1 VAN SubCor 0.008 -0.004 0.021 19 1.392 1.000 ns 0.311 small
p1 VAN TP -0.033 -0.037 -0.029 19 -17.664 0.000 **** -3.950 large
p1 Vis DAN 0.006 -0.004 0.016 19 1.271 1.000 ns 0.284 small
p1 Vis DMN 0.018 0.008 0.028 19 3.630 0.025 * 0.812 large
p1 Vis FPN 0.029 0.017 0.041 19 4.894 0.002 ** 1.094 large
p1 Vis Limb -0.023 -0.037 -0.008 19 -3.316 0.043 * -0.741 moderate
p1 Vis SM -0.026 -0.036 -0.016 19 -5.535 0.000 *** -1.238 large
p1 Vis SubCor 0.007 -0.008 0.022 19 1.000 1.000 ns 0.224 small
p1 Vis TP -0.034 -0.043 -0.025 19 -7.688 0.000 **** -1.719 large
p1 Vis VAN -0.001 -0.010 0.008 19 -0.288 1.000 ns -0.064 negligible
p2 All DAN -0.064 -0.073 -0.055 19 -15.347 0.000 **** -3.432 large
p2 All DMN -0.050 -0.055 -0.045 19 -20.437 0.000 **** -4.570 large
p2 All FPN -0.039 -0.044 -0.033 19 -14.935 0.000 **** -3.339 large
p2 All Limb -0.092 -0.098 -0.087 19 -32.589 0.000 **** -7.287 large
p2 All SM -0.093 -0.097 -0.088 19 -47.764 0.000 **** -10.680 large
p2 All SubCor -0.068 -0.079 -0.058 19 -13.802 0.000 **** -3.086 large
p2 All TP -0.100 -0.102 -0.098 19 -88.832 0.000 **** -19.863 large
p2 All VAN -0.067 -0.072 -0.063 19 -30.315 0.000 **** -6.779 large
p2 All Vis -0.065 -0.071 -0.059 19 -21.317 0.000 **** -4.767 large
p2 DAN DMN 0.014 0.005 0.022 19 3.366 0.029 * 0.753 moderate
p2 DAN Limb -0.028 -0.038 -0.019 19 -6.314 0.000 **** -1.412 large
p2 DAN SubCor -0.004 -0.018 0.009 19 -0.669 1.000 ns -0.150 negligible
p2 DAN TP -0.036 -0.044 -0.028 19 -9.224 0.000 **** -2.063 large
p2 DMN Limb -0.042 -0.050 -0.034 19 -11.358 0.000 **** -2.540 large
p2 DMN SubCor -0.018 -0.029 -0.007 19 -3.470 0.026 * -0.776 moderate
p2 DMN TP -0.050 -0.055 -0.045 19 -21.520 0.000 **** -4.812 large
p2 FPN DAN -0.025 -0.034 -0.017 19 -6.195 0.000 *** -1.385 large
p2 FPN DMN -0.012 -0.017 -0.006 19 -4.575 0.003 ** -1.023 large
p2 FPN Limb -0.054 -0.061 -0.046 19 -14.857 0.000 **** -3.322 large
p2 FPN SubCor -0.030 -0.042 -0.017 19 -5.004 0.001 ** -1.119 large
p2 FPN TP -0.061 -0.066 -0.056 19 -25.822 0.000 **** -5.774 large
p2 FPN VAN -0.029 -0.034 -0.023 19 -10.448 0.000 **** -2.336 large
p2 Limb SubCor 0.024 0.011 0.037 19 3.888 0.012 * 0.869 large
p2 Limb TP -0.007 -0.014 -0.001 19 -2.319 0.254 ns -0.518 moderate
p2 SM DAN 0.029 0.021 0.036 19 7.585 0.000 **** 1.696 large
p2 SM DMN 0.042 0.039 0.046 19 24.004 0.000 **** 5.367 large
p2 SM FPN 0.054 0.049 0.058 19 25.223 0.000 **** 5.640 large
p2 SM Limb 0.000 -0.008 0.008 19 0.021 1.000 ns 0.005 negligible
p2 SM SubCor 0.024 0.014 0.035 19 4.864 0.002 ** 1.088 large
p2 SM TP -0.007 -0.010 -0.005 19 -5.665 0.000 *** -1.267 large
p2 SM VAN 0.025 0.021 0.029 19 13.167 0.000 **** 2.944 large
p2 SubCor TP -0.032 -0.042 -0.021 19 -6.325 0.000 **** -1.414 large
p2 VAN DAN 0.003 -0.005 0.011 19 0.900 1.000 ns 0.201 small
p2 VAN DMN 0.017 0.012 0.022 19 6.885 0.000 **** 1.539 large
p2 VAN Limb -0.025 -0.033 -0.017 19 -6.877 0.000 **** -1.538 large
p2 VAN SubCor -0.001 -0.013 0.011 19 -0.183 1.000 ns -0.041 negligible
p2 VAN TP -0.033 -0.036 -0.029 19 -18.509 0.000 **** -4.139 large
p2 Vis DAN 0.001 -0.008 0.010 19 0.215 1.000 ns 0.048 negligible
p2 Vis DMN 0.015 0.007 0.023 19 3.876 0.012 * 0.867 large
p2 Vis FPN 0.026 0.018 0.034 19 6.714 0.000 **** 1.501 large
p2 Vis Limb -0.028 -0.037 -0.018 19 -5.800 0.000 *** -1.297 large
p2 Vis SM -0.028 -0.034 -0.021 19 -9.195 0.000 **** -2.056 large
p2 Vis SubCor -0.003 -0.014 0.007 19 -0.678 1.000 ns -0.152 negligible
p2 Vis TP -0.035 -0.040 -0.030 19 -13.975 0.000 **** -3.125 large
p2 Vis VAN -0.002 -0.007 0.002 19 -1.050 1.000 ns -0.235 small




6.5 Network Measures Analysis


보조적인 분석으로 Connectivity Matrix에 대한 Network 분석을 수행한다. 네트워크 분석은 복잡한 연결 구조를 Node(ROI), Edge 또는 Link(ROI 간 Fuunctional Connectivity)의 개념을 통해 정의하고, 이 들간의 집중도, 분산도, 강도 등을 분석하여 전체 네트워크 구조에 대한 특징을 확인한다. 여기서는 전체 brain connectivity의 Global Network Measure로 Modularity와 Global Efficiency를 분석하였다.


Modularity는 전체 Network의 연결 구조가 얼마나 잘 Community Structure로 구분되는지를 Louvain의 알고리즘을 통해 계산한다. 쉽게 말해서, 전체 네트워크가 개별 Community Structure로 분할되는 정도를 나타내는 것으로 네트워크가 기능적으로 Segregation이 되는지를 나타낸다.


Global Efficiency는 떨어져있는 노드 간의 연결 효율성을 나타내는 Path Length의 역술 계산되며, 전체 네트워크의 정보 전달 수용력을 반영한다. 높은 Global efficiency는 전체 네트워크에 속해있는 떨어져있논 노드들이 서로 효율적으로 정보 전달을 한다는 것(높은 연결성 정도)을 나타내는 것으로 네트워크 간의 통합을 나타낸다고 할 수 있다.


아래에서는 Modularity와 Global Efficiency가 구획 간 차이가 있는지를 살펴본다.



## FC
r11 <- read.csv("py_output/sFC_net_v2.csv", header = T)
r11_l <- r11 %>% dplyr::filter(sn %in% targ_sn)
r11_l$sn = factor(r11_l$sn)
r11_l$net = factor(r11_l$net,
                   levels = c('All', 'Vis', 'SM', 'FPN',
                                'VAN', 'DAN', 'DMN', 'Limb', 'SubCor','TP'),
                     labels = c('All', 'Vis', 'SM', 'FPN',
                                'VAN', 'DAN', 'DMN', 'Limb', 'SubCor','TP'))
r11_l$idx = factor(r11_l$idx)
r11_l$part = factor(r11_l$part, 
                    levels = c(1,2),
                    labels = c('p1','p2'))


## Behavior
r11_behav <- read.csv("data/aniFCnet_behav.csv", header = T)
glimpse(r11_behav, width = 80)
## Rows: 630
## Columns: 7
## $ Idx         <int> 26, 21, 12, 22, 7, 6, 4, 30, 29, 14, 5, 10, 28, 17, 19, 15…
## $ num         <int> 26, 21, 12, 22, 7, 6, 4, 30, 29, 14, 5, 10, 28, 17, 19, 15…
## $ stimIdx     <int> 2, 9, 10, 13, 15, 24, 25, 33, 44, 49, 58, 62, 68, 74, 81, …
## $ sn          <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1…
## $ correctness <int> 1, 1, 0, 0, 1, 1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1…
## $ scores      <int> 9, 9, 1, 1, 7, 9, 9, 1, 1, 7, 8, 9, 6, 6, 8, 9, 9, 6, 9, 6…
## $ check       <int> 0, 0, 1, 1, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
r11_behav <- r11_behav %>% dplyr::filter(sn %in% targ_sn)
r11_behav$sn = factor(r11_behav$sn)
r11_behav$idx = factor(r11_behav$stimIdx)
r11_behav$corr = r11_behav$correctness
r11_behav <- r11_behav %>% dplyr::select(sn, idx, corr, scores, check)

r11_1 <- merge(r11_l, r11_behav, by = c("sn", "idx"))
r11_2 <- r11_1
#r11_2 <- r11_1 %>% filter(corr == 1, check != 1)


6.5.1 Modularity


Modularity에 대한 요약과 통계 분석을 수행한다.



# subject-level, long format
r11_allL <- r11_2 %>% dplyr::filter(net == "All") %>% 
  group_by(sn, part) %>%
  dplyr::summarise(r=mean(md1)) %>%
  ungroup()
## `summarise()` has grouped output by 'sn'. You can override using the `.groups` argument.

# summary table: grand mean
r11_allG <- r11_allL %>% group_by( part) %>%
  dplyr::summarise(r.m = mean(r), r.sd = sd(r)) %>%
  ungroup()

r11_allG$r.se <- Rmisc::summarySEwithin(data = r11_allL, measurevar = "r", 
                                        idvar = "sn", withinvars = c("part"))$se
r11_allG$r.ci <- Rmisc::summarySEwithin(data = r11_allL, measurevar = "r", 
                                        idvar = "sn", withinvars = c("part"))$ci
r11_allG <- r11_allG %>% 
  mutate(lower.ci = r.m-r.ci,
         upper.ci = r.m+r.ci,
         lower.se = r.m-r.se,
         upper.se = r.m+r.se)

r11_allG %>% dplyr::select(part, r.m) %>%
  spread(key=part, value=r.m) %>% kable(digits=2)
p1 p2
0.46 0.45


r11_allL.p1 <- r11_allL
r11_allG.p1 <- r11_allG

r11.p1.all.plot1 <- ggplot(data=r11_allL.p1, aes(x=part, y=r, fill=part, shpae=part)) +
  stat_summary(fun = mean, geom = "bar", position="dodge", 
               na.rm = TRUE, alpha = .9, width = 0.8,  color="black", size = 0.15) +
  # facet_grid(.~net, scales="free_x", space = "free") +
  # geom_hline(yintercept=0, linetype='solid', color='black', alpha =1, size=1) +
  geom_point(data=r11_allL.p1, aes(x=part, y=r, fill=part), position = position_dodge(width=0.8),
             size=2, show.legend=F, color="gray90") +
  geom_errorbar(data=r11_allG.p1, aes(x=part, y= r.m, ymin=r.m-r.ci, ymax=r.m+r.ci), width=.2,
                position=position_dodge(.8), color = "black") +
  # scale_x_discrete(labels=c("Within", "Between")) +
  scale_fill_manual(values = c("#ED7D31", "#5B9BD5"), # c("#ED7D31", "#5B9BD5", "#70AD47"),
                    labels = c("First Half", "Second Half")) +  scale_color_brewer(palette="Set2") + 
  coord_cartesian(ylim = c(0.35, 0.6), clip = "on") +
  labs(x = "Part", y = "Modularity Score") +
  ggtitle("Modularity") +
  theme_bw(base_size = 18) +
  theme(#axis.text.x=element_blank(),
    #axis.ticks.x=element_blank(),
    axis.title = element_text(face = "bold", size = 16, color = "black"),
    axis.text = element_text(face = "plain", hjust = 0.5, size = 15, color = "black"),
    axis.line=element_line(),
    strip.text.x = element_text(face = "plain", size = 15, color = "black"),
    strip.background = element_blank(),
    panel.grid.major = element_blank(),
    panel.grid.minor = element_blank(),
    panel.border = element_blank(),
    panel.spacing=unit(1, "lines"),
    plot.margin = margin(1, 0.3, 1, 0.3, "cm"), 
    legend.title = element_blank(),
    legend.position="bottom")
# ggsave("fig1_1.fmri.jpg", plot = r3.p1.all.plot1, width=6, height=6, unit='in', dpi=600)
r11.p1.all.plot1


Modularity 통계 분석 결과는 아래와 같다.


r11_allL.1.tmp <- r11_allL

r11.aov1.tmp <- aov_ez(id="sn", dv="r", data = r11_allL.1.tmp, within = c("part"))
# summary(r11.aov1)
nice(r11.aov1.tmp, es="pes") %>% kable(digits=2)
Effect df MSE F pes p.value
part 1, 19 0.00 8.68 ** .314 .008
p_h1 <- r11_allL.1.tmp %>% 
  rstatix::pairwise_t_test(r ~ part, 
                           p.adjust.method="holm", 
                           paired=T, detailed=T) %>% 
  dplyr::select(group1, group2, estimate, conf.low, conf.high, df, statistic, p.adj, p.adj.signif) 
p_h2 <- r11_allL.1.tmp %>% 
  rstatix::cohens_d(r ~ part, paired=T, ci = F) %>% 
  dplyr::select(group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("group1", "group2")) %>% kable(digits=3)
group1 group2 estimate conf.low conf.high df statistic p.adj p.adj.signif effsize magnitude
p1 p2 0.011 0.003 0.018 19 2.947 0.008 ** 0.659 moderate


6.5.2 Global Efficiency


Global Efficiency에 대한 요약과 통계 분석을 수행한다.



# subject-level, long format
r11_allL <- r11_2 %>% dplyr::filter(net == "All") %>% 
  group_by(sn, part) %>%
  dplyr::summarise(r=mean(ge)) %>%
  ungroup()
## `summarise()` has grouped output by 'sn'. You can override using the `.groups` argument.

# summary table: grand mean
r11_allG <- r11_allL %>% group_by( part) %>%
  dplyr::summarise(r.m = mean(r), r.sd = sd(r)) %>%
  ungroup()

r11_allG$r.se <- Rmisc::summarySEwithin(data = r11_allL, measurevar = "r", 
                                        idvar = "sn", withinvars = c("part"))$se
r11_allG$r.ci <- Rmisc::summarySEwithin(data = r11_allL, measurevar = "r", 
                                        idvar = "sn", withinvars = c("part"))$ci
r11_allG <- r11_allG %>% 
  mutate(lower.ci = r.m-r.ci,
         upper.ci = r.m+r.ci,
         lower.se = r.m-r.se,
         upper.se = r.m+r.se)

r11_allG %>% dplyr::select(part, r.m) %>%
  spread(key=part, value=r.m) %>% kable(digits=2)
p1 p2
0.26 0.24


r11_allL.p1 <- r11_allL
r11_allG.p1 <- r11_allG

r11.p1.all.plot1 <- ggplot(data=r11_allL.p1, aes(x=part, y=r, fill=part, shpae=part)) +
  stat_summary(fun = mean, geom = "bar", position="dodge", 
               na.rm = TRUE, alpha = .9, width = 0.8,  color="black", size = 0.15) +
  # facet_grid(.~net, scales="free_x", space = "free") +
  # geom_hline(yintercept=0, linetype='solid', color='black', alpha =1, size=1) +
  geom_point(data=r11_allL.p1, aes(x=part, y=r, fill=part), position = position_dodge(width=0.8),
             size=2, show.legend=F, color="gray90") +
  geom_errorbar(data=r11_allG.p1, aes(x=part, y= r.m, ymin=r.m-r.ci, ymax=r.m+r.ci), width=.2,
                position=position_dodge(.8), color = "black") +
  # scale_x_discrete(labels=c("Within", "Between")) +
  scale_fill_manual(values = c("#ED7D31", "#5B9BD5"), # c("#ED7D31", "#5B9BD5", "#70AD47"),
                    labels = c("First Half", "Second Half")) +  scale_color_brewer(palette="Set2") + 
  coord_cartesian(ylim = c(0.2, 0.3), clip = "on") +
  labs(x = "Part", y = "Global Efficiency") +
  ggtitle("Global Efficiency") +
  theme_bw(base_size = 18) +
  theme(#axis.text.x=element_blank(),
    #axis.ticks.x=element_blank(),
    axis.title = element_text(face = "bold", size = 16, color = "black"),
    axis.text = element_text(face = "plain", hjust = 0.5, size = 15, color = "black"),
    axis.line=element_line(),
    strip.text.x = element_text(face = "plain", size = 15, color = "black"),
    strip.background = element_blank(),
    panel.grid.major = element_blank(),
    panel.grid.minor = element_blank(),
    panel.border = element_blank(),
    panel.spacing=unit(1, "lines"),
    plot.margin = margin(1, 0.3, 1, 0.3, "cm"), 
    legend.title = element_blank(),
    legend.position="bottom")
# ggsave("fig1_1.fmri.jpg", plot = r3.p1.all.plot1, width=6, height=6, unit='in', dpi=600)
r11.p1.all.plot1


Global Efficiency의 통계 분석 결과는 아래와 같다.


r11_allL.1.tmp <- r11_allL

r11.aov1.tmp <- aov_ez(id="sn", dv="r", data = r11_allL.1.tmp, within = c("part"))
# summary(r11.aov1)
nice(r11.aov1.tmp, es="pes") %>% kable(digits=2)
Effect df MSE F pes p.value
part 1, 19 0.00 374.64 *** .952 <.001
p_h1 <- r11_allL.1.tmp %>% 
  rstatix::pairwise_t_test(r ~ part, 
                           p.adjust.method="holm", 
                           paired=T, detailed=T) %>% 
  dplyr::select(group1, group2, estimate, conf.low, conf.high, df, statistic, p.adj, p.adj.signif) 
p_h2 <- r11_allL.1.tmp %>% 
  rstatix::cohens_d(r ~ part, paired=T, ci = F) %>% 
  dplyr::select(group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("group1", "group2")) %>% kable(digits=3)
group1 group2 estimate conf.low conf.high df statistic p.adj p.adj.signif effsize magnitude
p1 p2 0.017 0.015 0.018 19 19.356 0 **** 4.328 large


6.5.3 Participation Coefficient


Participation Coefficiecny



# subject-level, long format
r11_allL <- r11_2 %>% 
  dplyr::filter(net !="All") %>% 
  group_by(sn, net, part) %>%
  dplyr::summarise(r=mean(p_pc)) %>%
  ungroup()
## `summarise()` has grouped output by 'sn', 'net'. You can override using the `.groups` argument.

# summary table: grand mean
r11_allG <- r11_allL %>% group_by(net, part) %>%
  dplyr::summarise(r.m = mean(r), r.sd = sd(r)) %>%
  ungroup()
## `summarise()` has grouped output by 'net'. You can override using the `.groups` argument.

r11_allG$r.se <- Rmisc::summarySEwithin(data = r11_allL, measurevar = "r", 
                                        idvar = "sn", withinvars = c("net","part"))$se
r11_allG$r.ci <- Rmisc::summarySEwithin(data = r11_allL, measurevar = "r", 
                                        idvar = "sn", withinvars = c("net","part"))$ci
r11_allG <- r11_allG %>% 
  mutate(lower.ci = r.m-r.ci,
         upper.ci = r.m+r.ci,
         lower.se = r.m-r.se,
         upper.se = r.m+r.se)

r11_allG %>% dplyr::select(net, part, r.m) %>%
  spread(key=part, value=r.m) %>% kable(digits=2)
net p1 p2
Vis 0.79 0.79
SM 0.81 0.81
FPN 0.77 0.77
VAN 0.79 0.78
DAN 0.80 0.80
DMN 0.81 0.81
Limb 0.78 0.78
SubCor 0.83 0.83
TP 0.78 0.79


r11_allL.p1 <- r11_allL
r11_allG.p1 <- r11_allG

r11.p1.all.plot1 <- ggplot(data=r11_allL.p1, aes(x=part, y=r, fill=part, shpae=part)) +
  stat_summary(fun = mean, geom = "bar", position="dodge", 
               na.rm = TRUE, alpha = .9, width = 0.8,  color="black", size = 0.15) +
  facet_grid(.~net, scales="free_x", space = "free") +
  geom_hline(yintercept=0, linetype='solid', color='black', alpha =1, size=1) +
  geom_point(data=r11_allL.p1, aes(x=part, y=r, fill=part), position = position_dodge(width=0.8),
             size=2, show.legend=F, color="gray90") +
  geom_errorbar(data=r11_allG.p1, aes(x=part, y= r.m, ymin=r.m-r.ci, ymax=r.m+r.ci), width=.2,
                position=position_dodge(.8), color = "black") +
  # scale_x_discrete(labels=c("Within", "Between")) +
  scale_fill_manual(values = c("#ED7D31", "#5B9BD5"), # c("#ED7D31", "#5B9BD5", "#70AD47"),
                    labels = c("First Half", "Second Half")) +  scale_color_brewer(palette="Set2") + 
  # coord_cartesian(ylim = c(-0.4, 0.4), clip = "on") +
  labs(x = "Part", y = "Participation Coefficient") +
  ggtitle("Participation Coefficient") +
  theme_bw(base_size = 18) +
  theme(#axis.text.x=element_blank(),
    #axis.ticks.x=element_blank(),
    axis.title = element_text(face = "bold", size = 16, color = "black"),
    axis.text = element_text(face = "plain", hjust = 0.5, size = 15, color = "black"),
    axis.line=element_line(),
    strip.text.x = element_text(face = "plain", size = 15, color = "black"),
    strip.background = element_blank(),
    panel.grid.major = element_blank(),
    panel.grid.minor = element_blank(),
    panel.border = element_blank(),
    panel.spacing=unit(1, "lines"),
    plot.margin = margin(1, 0.3, 1, 0.3, "cm"), 
    legend.title = element_blank(),
    legend.position="bottom")
# ggsave("fig1_1.fmri.jpg", plot = r3.p1.all.plot1, width=6, height=6, unit='in', dpi=600)
r11.p1.all.plot1


Participation Coefficient 통계 분석 결과


r11_allL.1.tmp <- r11_allL

r11.aov1.tmp <- aov_ez(id="sn", dv="r", data = r11_allL.1.tmp, within = c("net","part"))
# summary(r11.aov1)
nice(r11.aov1.tmp, es="pes") %>% kable(digits=2)
Effect df MSE F pes p.value
net 2.03, 38.61 0.00 24.74 *** .566 <.001
part 1, 19 0.00 3.65 + .161 .071
net:part 4.89, 92.94 0.00 5.71 *** .231 <.001
p_h1 <- r11_allL.1.tmp %>% group_by(net) %>% 
  rstatix::pairwise_t_test(r ~ part, 
                           p.adjust.method="holm", 
                           paired=T, detailed=T) %>% 
  dplyr::select(net, group1, group2, estimate, conf.low, conf.high, df, statistic, p.adj, p.adj.signif) 
p_h2 <- r11_allL.1.tmp %>% group_by(net) %>% 
  rstatix::cohens_d(r ~ part, paired=T, ci = F) %>% 
  dplyr::select(net, group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("net", "group1", "group2")) %>% kable(digits=3)
net group1 group2 estimate conf.low conf.high df statistic p.adj p.adj.signif effsize magnitude
DAN p1 p2 0.002 0.000 0.004 19 2.601 0.018 * 0.582 moderate
DMN p1 p2 0.001 0.000 0.002 19 1.588 0.129 ns 0.355 small
FPN p1 p2 0.003 0.000 0.005 19 2.278 0.034 * 0.509 moderate
Limb p1 p2 0.003 0.000 0.005 19 2.503 0.022 * 0.560 moderate
SM p1 p2 -0.001 -0.002 0.001 19 -0.923 0.367 ns -0.206 small
SubCor p1 p2 0.000 -0.002 0.002 19 0.162 0.873 ns 0.036 negligible
TP p1 p2 -0.002 -0.005 0.002 19 -0.971 0.344 ns -0.217 small
VAN p1 p2 0.004 0.003 0.006 19 5.160 0.000 **** 1.154 large
Vis p1 p2 0.000 -0.002 0.001 19 -0.356 0.726 ns -0.080 negligible
p_h1 <- r11_allL.1.tmp %>% group_by(part) %>% 
  rstatix::pairwise_t_test(r ~ net, 
                           p.adjust.method="holm", 
                           paired=T, detailed=T) %>% 
  dplyr::select(part, group1, group2, estimate, conf.low, conf.high, df, statistic, p.adj, p.adj.signif) 
p_h2 <- r11_allL.1.tmp %>% group_by(part) %>% 
  rstatix::cohens_d(r ~ net, paired=T, ci = F) %>% 
  dplyr::select(part, group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("part", "group1", "group2")) %>% kable(digits=3)
part group1 group2 estimate conf.low conf.high df statistic p.adj p.adj.signif effsize magnitude
p1 DAN DMN -0.007 -0.010 -0.004 19 -5.351 0.001 *** -1.196 large
p1 DAN Limb 0.018 0.012 0.023 19 6.379 0.000 **** 1.426 large
p1 DAN SubCor -0.026 -0.030 -0.023 19 -17.263 0.000 **** -3.860 large
p1 DAN TP 0.015 0.008 0.021 19 4.619 0.003 ** 1.033 large
p1 DMN Limb 0.025 0.019 0.030 19 9.061 0.000 **** 2.026 large
p1 DMN SubCor -0.019 -0.021 -0.017 19 -21.475 0.000 **** -4.802 large
p1 DMN TP 0.022 0.016 0.027 19 8.435 0.000 **** 1.886 large
p1 FPN DAN -0.031 -0.037 -0.026 19 -11.915 0.000 **** -2.664 large
p1 FPN DMN -0.038 -0.044 -0.032 19 -14.117 0.000 **** -3.157 large
p1 FPN Limb -0.014 -0.018 -0.009 19 -6.578 0.000 **** -1.471 large
p1 FPN SubCor -0.057 -0.063 -0.052 19 -22.232 0.000 **** -4.971 large
p1 FPN TP -0.016 -0.022 -0.010 19 -5.687 0.000 *** -1.272 large
p1 FPN VAN -0.019 -0.023 -0.014 19 -9.297 0.000 **** -2.079 large
p1 Limb SubCor -0.044 -0.049 -0.038 19 -16.639 0.000 **** -3.721 large
p1 Limb TP -0.003 -0.009 0.004 19 -0.931 1.000 ns -0.208 small
p1 SM DAN 0.006 -0.007 0.018 19 0.972 1.000 ns 0.217 small
p1 SM DMN -0.001 -0.013 0.011 19 -0.231 1.000 ns -0.052 negligible
p1 SM FPN 0.037 0.023 0.051 19 5.518 0.001 *** 1.234 large
p1 SM Limb 0.023 0.010 0.036 19 3.750 0.022 * 0.838 large
p1 SM SubCor -0.021 -0.032 -0.009 19 -3.723 0.022 * -0.832 large
p1 SM TP 0.020 0.008 0.033 19 3.366 0.046 * 0.753 moderate
p1 SM VAN 0.018 0.005 0.031 19 2.918 0.106 ns 0.652 moderate
p1 SubCor TP 0.041 0.036 0.046 19 16.103 0.000 **** 3.601 large
p1 VAN DAN -0.012 -0.016 -0.009 19 -7.431 0.000 **** -1.662 large
p1 VAN DMN -0.019 -0.024 -0.015 19 -9.306 0.000 **** -2.081 large
p1 VAN Limb 0.005 0.000 0.010 19 2.034 0.618 ns 0.455 small
p1 VAN SubCor -0.039 -0.043 -0.034 19 -17.822 0.000 **** -3.985 large
p1 VAN TP 0.002 -0.005 0.009 19 0.651 1.000 ns 0.146 negligible
p1 Vis DAN -0.005 -0.021 0.010 19 -0.688 1.000 ns -0.154 negligible
p1 Vis DMN -0.012 -0.028 0.004 19 -1.583 1.000 ns -0.354 small
p1 Vis FPN 0.026 0.008 0.044 19 3.053 0.085 ns 0.683 moderate
p1 Vis Limb 0.012 -0.004 0.029 19 1.577 1.000 ns 0.353 small
p1 Vis SM -0.011 -0.023 0.002 19 -1.801 0.876 ns -0.403 small
p1 Vis SubCor -0.031 -0.047 -0.016 19 -4.184 0.009 ** -0.936 large
p1 Vis TP 0.010 -0.009 0.028 19 1.102 1.000 ns 0.246 small
p1 Vis VAN 0.007 -0.009 0.024 19 0.947 1.000 ns 0.212 small
p2 DAN DMN -0.008 -0.011 -0.005 19 -5.992 0.000 *** -1.340 large
p2 DAN Limb 0.018 0.013 0.024 19 6.527 0.000 **** 1.460 large
p2 DAN SubCor -0.028 -0.032 -0.025 19 -16.407 0.000 **** -3.669 large
p2 DAN TP 0.011 0.005 0.017 19 3.774 0.020 * 0.844 large
p2 DMN Limb 0.026 0.020 0.032 19 9.256 0.000 **** 2.070 large
p2 DMN SubCor -0.020 -0.023 -0.018 19 -17.427 0.000 **** -3.897 large
p2 DMN TP 0.019 0.013 0.025 19 6.655 0.000 **** 1.488 large
p2 FPN DAN -0.032 -0.037 -0.027 19 -12.704 0.000 **** -2.841 large
p2 FPN DMN -0.040 -0.045 -0.034 19 -15.155 0.000 **** -3.389 large
p2 FPN Limb -0.013 -0.018 -0.009 19 -6.394 0.000 **** -1.430 large
p2 FPN SubCor -0.060 -0.066 -0.055 19 -23.036 0.000 **** -5.151 large
p2 FPN TP -0.021 -0.028 -0.014 19 -6.047 0.000 *** -1.352 large
p2 FPN VAN -0.017 -0.021 -0.013 19 -9.650 0.000 **** -2.158 large
p2 Limb SubCor -0.047 -0.052 -0.041 19 -17.317 0.000 **** -3.872 large
p2 Limb TP -0.007 -0.014 -0.001 19 -2.336 0.337 ns -0.522 moderate
p2 SM DAN 0.008 -0.004 0.021 19 1.382 1.000 ns 0.309 small
p2 SM DMN 0.000 -0.012 0.013 19 0.084 1.000 ns 0.019 negligible
p2 SM FPN 0.040 0.026 0.054 19 5.936 0.000 *** 1.327 large
p2 SM Limb 0.027 0.014 0.040 19 4.204 0.009 ** 0.940 large
p2 SM SubCor -0.020 -0.032 -0.008 19 -3.498 0.034 * -0.782 moderate
p2 SM TP 0.020 0.007 0.033 19 3.166 0.061 ns 0.708 moderate
p2 SM VAN 0.023 0.010 0.037 19 3.532 0.033 * 0.790 moderate
p2 SubCor TP 0.039 0.034 0.045 19 14.466 0.000 **** 3.235 large
p2 VAN DAN -0.015 -0.019 -0.011 19 -7.465 0.000 **** -1.669 large
p2 VAN DMN -0.023 -0.028 -0.018 19 -9.810 0.000 **** -2.194 large
p2 VAN Limb 0.004 -0.002 0.009 19 1.332 1.000 ns 0.298 small
p2 VAN SubCor -0.043 -0.049 -0.038 19 -16.883 0.000 **** -3.775 large
p2 VAN TP -0.004 -0.012 0.005 19 -0.950 1.000 ns -0.212 small
p2 Vis DAN -0.003 -0.019 0.013 19 -0.363 1.000 ns -0.081 negligible
p2 Vis DMN -0.011 -0.027 0.005 19 -1.416 1.000 ns -0.317 small
p2 Vis FPN 0.029 0.012 0.047 19 3.473 0.034 * 0.777 moderate
p2 Vis Limb 0.016 -0.001 0.033 19 1.948 0.641 ns 0.435 small
p2 Vis SM -0.011 -0.023 0.001 19 -1.966 0.641 ns -0.440 small
p2 Vis SubCor -0.031 -0.047 -0.015 19 -4.167 0.009 ** -0.932 large
p2 Vis TP 0.008 -0.010 0.027 19 0.962 1.000 ns 0.215 small
p2 Vis VAN 0.012 -0.005 0.029 19 1.515 1.000 ns 0.339 small


6.5.4 Local Efficiecny


Local Efficiency, 노드 별 Effciecny



# subject-level, long format
r11_allL <- r11_2 %>% 
  dplyr::filter(net !="All") %>% 
  group_by(sn, net, part) %>%
  dplyr::summarise(r=mean(le)) %>%
  ungroup()
## `summarise()` has grouped output by 'sn', 'net'. You can override using the `.groups` argument.

# summary table: grand mean
r11_allG <- r11_allL %>% group_by(net, part) %>%
  dplyr::summarise(r.m = mean(r), r.sd = sd(r)) %>%
  ungroup()
## `summarise()` has grouped output by 'net'. You can override using the `.groups` argument.

r11_allG$r.se <- Rmisc::summarySEwithin(data = r11_allL, measurevar = "r", 
                                        idvar = "sn", withinvars = c("net","part"))$se
r11_allG$r.ci <- Rmisc::summarySEwithin(data = r11_allL, measurevar = "r", 
                                        idvar = "sn", withinvars = c("net","part"))$ci
r11_allG <- r11_allG %>% 
  mutate(lower.ci = r.m-r.ci,
         upper.ci = r.m+r.ci,
         lower.se = r.m-r.se,
         upper.se = r.m+r.se)

r11_allG %>% dplyr::select(net, part, r.m) %>%
  spread(key=part, value=r.m) %>% kable(digits=2)
net p1 p2
Vis 0.22 0.19
SM 0.22 0.20
FPN 0.23 0.21
VAN 0.23 0.21
DAN 0.23 0.22
DMN 0.22 0.21
Limb 0.23 0.21
SubCor 0.20 0.18
TP 0.23 0.22


r11_allL.p1 <- r11_allL
r11_allG.p1 <- r11_allG

r11.p1.all.plot1 <- ggplot(data=r11_allL.p1, aes(x=part, y=r, fill=part, shpae=part)) +
  stat_summary(fun = mean, geom = "bar", position="dodge", 
               na.rm = TRUE, alpha = .9, width = 0.8,  color="black", size = 0.15) +
  facet_grid(.~net, scales="free_x", space = "free") +
  geom_hline(yintercept=0, linetype='solid', color='black', alpha =1, size=1) +
  geom_point(data=r11_allL.p1, aes(x=part, y=r, fill=part), position = position_dodge(width=0.8),
             size=2, show.legend=F, color="gray90") +
  geom_errorbar(data=r11_allG.p1, aes(x=part, y= r.m, ymin=r.m-r.ci, ymax=r.m+r.ci), width=.2,
                position=position_dodge(.8), color = "black") +
  # scale_x_discrete(labels=c("Within", "Between")) +
  scale_fill_manual(values = c("#ED7D31", "#5B9BD5"), # c("#ED7D31", "#5B9BD5", "#70AD47"),
                    labels = c("First Half", "Second Half")) +  scale_color_brewer(palette="Set2") + 
  # coord_cartesian(ylim = c(-0.4, 0.4), clip = "on") +
  labs(x = "Part", y = "Local Efficiency") +
  ggtitle("Local Efficiency") +
  theme_bw(base_size = 18) +
  theme(#axis.text.x=element_blank(),
    #axis.ticks.x=element_blank(),
    axis.title = element_text(face = "bold", size = 16, color = "black"),
    axis.text = element_text(face = "plain", hjust = 0.5, size = 15, color = "black"),
    axis.line=element_line(),
    strip.text.x = element_text(face = "plain", size = 15, color = "black"),
    strip.background = element_blank(),
    panel.grid.major = element_blank(),
    panel.grid.minor = element_blank(),
    panel.border = element_blank(),
    panel.spacing=unit(1, "lines"),
    plot.margin = margin(1, 0.3, 1, 0.3, "cm"), 
    legend.title = element_blank(),
    legend.position="bottom")
# ggsave("fig1_1.fmri.jpg", plot = r3.p1.all.plot1, width=6, height=6, unit='in', dpi=600)
r11.p1.all.plot1


Local Efficiency 통계 분석 결과


r11_allL.1.tmp <- r11_allL

r11.aov1.tmp <- aov_ez(id="sn", dv="r", data = r11_allL.1.tmp, within = c("net","part"))
# summary(r11.aov1)
nice(r11.aov1.tmp, es="pes") %>% kable(digits=2)
Effect df MSE F pes p.value
net 3.80, 72.29 0.00 69.10 *** .784 <.001
part 1, 19 0.00 190.62 *** .909 <.001
net:part 4.78, 90.90 0.00 5.44 *** .222 <.001
p_h1 <- r11_allL.1.tmp %>% group_by(net) %>% 
  rstatix::pairwise_t_test(r ~ part, 
                           p.adjust.method="holm", 
                           paired=T, detailed=T) %>% 
  dplyr::select(net, group1, group2, estimate, conf.low, conf.high, df, statistic, p.adj, p.adj.signif) 
p_h2 <- r11_allL.1.tmp %>% group_by(net) %>% 
  rstatix::cohens_d(r ~ part, paired=T, ci = F) %>% 
  dplyr::select(net, group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("net", "group1", "group2")) %>% kable(digits=3)
net group1 group2 estimate conf.low conf.high df statistic p.adj p.adj.signif effsize magnitude
DAN p1 p2 0.017 0.014 0.021 19 10.521 0 **** 2.353 large
DMN p1 p2 0.017 0.015 0.020 19 15.029 0 **** 3.360 large
FPN p1 p2 0.020 0.017 0.024 19 11.619 0 **** 2.598 large
Limb p1 p2 0.016 0.013 0.020 19 9.621 0 **** 2.151 large
SM p1 p2 0.019 0.016 0.023 19 10.725 0 **** 2.398 large
SubCor p1 p2 0.016 0.014 0.019 19 12.012 0 **** 2.686 large
TP p1 p2 0.019 0.015 0.023 19 9.224 0 **** 2.063 large
VAN p1 p2 0.017 0.013 0.020 19 11.227 0 **** 2.510 large
Vis p1 p2 0.024 0.020 0.028 19 11.931 0 **** 2.668 large
p_h1 <- r11_allL.1.tmp %>% group_by(part) %>% 
  rstatix::pairwise_t_test(r ~ net, 
                           p.adjust.method="holm", 
                           paired=T, detailed=T) %>% 
  dplyr::select(part, group1, group2, estimate, conf.low, conf.high, df, statistic, p.adj, p.adj.signif) 
p_h2 <- r11_allL.1.tmp %>% group_by(part) %>% 
  rstatix::cohens_d(r ~ net, paired=T, ci = F) %>% 
  dplyr::select(part, group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("part", "group1", "group2")) %>% kable(digits=3)
part group1 group2 estimate conf.low conf.high df statistic p.adj p.adj.signif effsize magnitude
p1 DAN DMN 0.009 0.006 0.012 19 6.077 0.000 *** 1.359 large
p1 DAN Limb 0.006 0.002 0.010 19 3.430 0.037 * 0.767 moderate
p1 DAN SubCor 0.034 0.031 0.038 19 20.872 0.000 **** 4.667 large
p1 DAN TP -0.001 -0.007 0.004 19 -0.511 1.000 ns -0.114 negligible
p1 DMN Limb -0.002 -0.005 0.001 19 -1.579 0.678 ns -0.353 small
p1 DMN SubCor 0.026 0.022 0.029 19 16.092 0.000 **** 3.598 large
p1 DMN TP -0.010 -0.016 -0.004 19 -3.494 0.034 * -0.781 moderate
p1 FPN DAN 0.001 -0.002 0.005 19 0.736 1.000 ns 0.165 negligible
p1 FPN DMN 0.010 0.007 0.013 19 7.193 0.000 **** 1.608 large
p1 FPN Limb 0.008 0.005 0.010 19 5.937 0.000 *** 1.328 large
p1 FPN SubCor 0.035 0.032 0.039 19 20.955 0.000 **** 4.686 large
p1 FPN TP 0.000 -0.007 0.006 19 -0.078 1.000 ns -0.018 negligible
p1 FPN VAN 0.005 0.002 0.008 19 4.017 0.013 * 0.898 large
p1 Limb SubCor 0.028 0.024 0.032 19 14.554 0.000 **** 3.254 large
p1 Limb TP -0.008 -0.014 -0.001 19 -2.528 0.184 ns -0.565 moderate
p1 SM DAN -0.011 -0.016 -0.007 19 -5.902 0.000 *** -1.320 large
p1 SM DMN -0.003 -0.007 0.001 19 -1.375 0.740 ns -0.308 small
p1 SM FPN -0.013 -0.016 -0.009 19 -7.150 0.000 **** -1.599 large
p1 SM Limb -0.005 -0.009 -0.001 19 -2.401 0.214 ns -0.537 moderate
p1 SM SubCor 0.023 0.018 0.028 19 9.614 0.000 **** 2.150 large
p1 SM TP -0.013 -0.019 -0.007 19 -4.268 0.007 ** -0.954 large
p1 SM VAN -0.007 -0.011 -0.003 19 -3.884 0.016 * -0.869 large
p1 SubCor TP -0.036 -0.042 -0.029 19 -11.433 0.000 **** -2.557 large
p1 VAN DAN -0.004 -0.007 -0.001 19 -3.117 0.062 ns -0.697 moderate
p1 VAN DMN 0.005 0.003 0.006 19 5.856 0.000 *** 1.310 large
p1 VAN Limb 0.002 -0.001 0.005 19 1.663 0.678 ns 0.372 small
p1 VAN SubCor 0.030 0.027 0.034 19 17.843 0.000 **** 3.990 large
p1 VAN TP -0.005 -0.012 0.001 19 -1.838 0.572 ns -0.411 small
p1 Vis DAN -0.017 -0.022 -0.011 19 -6.589 0.000 **** -1.473 large
p1 Vis DMN -0.008 -0.013 -0.003 19 -3.371 0.039 * -0.754 moderate
p1 Vis FPN -0.018 -0.023 -0.013 19 -7.720 0.000 **** -1.726 large
p1 Vis Limb -0.010 -0.017 -0.004 19 -3.526 0.034 * -0.788 moderate
p1 Vis SM -0.005 -0.010 -0.001 19 -2.642 0.161 ns -0.591 moderate
p1 Vis SubCor 0.017 0.012 0.023 19 6.310 0.000 *** 1.411 large
p1 Vis TP -0.018 -0.026 -0.011 19 -5.003 0.001 ** -1.119 large
p1 Vis VAN -0.013 -0.018 -0.008 19 -5.570 0.000 *** -1.246 large
p2 DAN DMN 0.009 0.006 0.011 19 6.287 0.000 *** 1.406 large
p2 DAN Limb 0.005 0.002 0.009 19 3.012 0.086 ns 0.673 moderate
p2 DAN SubCor 0.033 0.030 0.036 19 22.745 0.000 **** 5.086 large
p2 DAN TP 0.000 -0.004 0.005 19 0.092 0.927 ns 0.021 negligible
p2 DMN Limb -0.003 -0.007 0.000 19 -2.096 0.398 ns -0.469 small
p2 DMN SubCor 0.025 0.022 0.027 19 20.832 0.000 **** 4.658 large
p2 DMN TP -0.008 -0.013 -0.004 19 -4.003 0.010 ** -0.895 large
p2 FPN DAN -0.002 -0.005 0.001 19 -1.278 0.895 ns -0.286 small
p2 FPN DMN 0.007 0.004 0.009 19 5.168 0.001 *** 1.156 large
p2 FPN Limb 0.003 0.001 0.006 19 2.817 0.110 ns 0.630 moderate
p2 FPN SubCor 0.031 0.028 0.035 19 21.083 0.000 **** 4.714 large
p2 FPN TP -0.002 -0.006 0.003 19 -0.754 0.920 ns -0.169 negligible
p2 FPN VAN 0.001 -0.001 0.004 19 1.308 0.895 ns 0.292 small
p2 Limb SubCor 0.028 0.024 0.032 19 15.367 0.000 **** 3.436 large
p2 Limb TP -0.005 -0.011 0.000 19 -1.912 0.498 ns -0.428 small
p2 SM DAN -0.014 -0.017 -0.010 19 -7.972 0.000 **** -1.783 large
p2 SM DMN -0.005 -0.009 -0.001 19 -2.895 0.102 ns -0.647 moderate
p2 SM FPN -0.012 -0.015 -0.009 19 -7.813 0.000 **** -1.747 large
p2 SM Limb -0.008 -0.012 -0.004 19 -4.294 0.005 ** -0.960 large
p2 SM SubCor 0.020 0.016 0.024 19 10.465 0.000 **** 2.340 large
p2 SM TP -0.013 -0.020 -0.007 19 -4.504 0.004 ** -1.007 large
p2 SM VAN -0.010 -0.014 -0.007 19 -6.005 0.000 *** -1.343 large
p2 SubCor TP -0.033 -0.038 -0.028 19 -14.247 0.000 **** -3.186 large
p2 VAN DAN -0.003 -0.006 -0.001 19 -2.762 0.112 ns -0.618 moderate
p2 VAN DMN 0.005 0.003 0.007 19 5.795 0.000 *** 1.296 large
p2 VAN Limb 0.002 -0.001 0.004 19 1.669 0.666 ns 0.373 small
p2 VAN SubCor 0.030 0.027 0.033 19 22.687 0.000 **** 5.073 large
p2 VAN TP -0.003 -0.008 0.002 19 -1.395 0.895 ns -0.312 small
p2 Vis DAN -0.023 -0.028 -0.019 19 -10.594 0.000 **** -2.369 large
p2 Vis DMN -0.015 -0.020 -0.010 19 -6.211 0.000 *** -1.389 large
p2 Vis FPN -0.022 -0.026 -0.017 19 -10.102 0.000 **** -2.259 large
p2 Vis Limb -0.018 -0.024 -0.012 19 -6.601 0.000 **** -1.476 large
p2 Vis SM -0.010 -0.013 -0.007 19 -6.353 0.000 **** -1.421 large
p2 Vis SubCor 0.010 0.006 0.014 19 4.825 0.002 ** 1.079 large
p2 Vis TP -0.023 -0.030 -0.017 19 -7.363 0.000 **** -1.647 large
p2 Vis VAN -0.020 -0.025 -0.015 19 -8.691 0.000 **** -1.943 large


6.5.5 Correlation Analysis


Modularity, Efficiency가 영상에 대한 이해도와 관련성이 있는지 확인한다.


6.5.5.1 Part 1 - Efficiency & Comprehension


r11_5 <- r11_2 %>% filter(check != 1) #corr == 1,
r11_6 <- r11_5 %>% filter(part == "p1", net == "All") %>% dplyr::select(sn, net,idx, part, ge, md1, scores, corr)
r11_6.L <- r11_6 %>% group_by(sn) %>% 
  dplyr::summarise(ge.m = mean(ge), m.m = mean(md1), scores.m = mean(scores)) %>% 
  ungroup()

cor.z <- cor.test(formula = ~ ge.m + scores.m, data = r11_6.L,
                  method = "pearson", alternative = "two.sided", exact=FALSE) # exact=FALSE
cor.z
## 
##  Pearson's product-moment correlation
## 
## data:  ge.m and scores.m
## t = -1.8265, df = 18, p-value = 0.08441
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.7131528  0.0570895
## sample estimates:
##        cor 
## -0.3954209

# cor.z <- cor.test(formula = ~ md1 + scores, data = r11_6,
                  # method = "pearson", alternative = "two.sided", exact=FALSE) # exact=FALSE


r11.corr.ge <-ggplot(r11_6.L, aes(x=ge.m, y=scores.m)) +
  geom_point(size = 4) +
  geom_smooth(method=lm) +
  labs(x = sprintf("Global Efficiency"),
       y = sprintf("Comprehension Scores"))+
  ggtitle("Part 1 - Global Efficiency") +
  # coord_cartesian(xlim = c(-3,3), ylim = c(-3,4)) + 
  theme_bw(base_size = 15) +
  theme(axis.title = element_text(face = "bold", size = 16, color = "black"),
        axis.text = element_text(face = "plain", hjust = 0.5, size = 15, color = "black"),
        axis.line=element_line(),
        strip.text.x = element_text(face = "plain", size = 15, color = "black"),
        strip.background = element_blank(),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.border = element_blank(),
        panel.spacing=unit(1, "lines"),
        legend.position = c(0.65, 0.85),
        legend.title = element_blank(),
        aspect.ratio = 1,
        legend.background = element_blank(),
        plot.margin = margin(1, 0.5, 0.5, 0.7, "cm"),
        legend.key = element_blank())
r11.corr.ge
## `geom_smooth()` using formula 'y ~ x'

6.5.5.2 Part 2 - Efficiency & Comprehension


r11_5 <- r11_2 %>% filter(check != 1) #corr == 1,
r11_6 <- r11_5 %>% filter(part == "p2", net == "All") %>% dplyr::select(sn, net,idx, part, ge, md1, scores, corr)
r11_6.L <- r11_6 %>% group_by(sn) %>% 
  dplyr::summarise(ge.m = mean(ge), m.m = mean(md1), scores.m = mean(scores)) %>% 
  ungroup()
r11_6.L <- r11_6.L %>% filter(sn != 16)
cor.z <- cor.test(formula = ~ ge.m + scores.m, data = r11_6.L,
                  method = "pearson", alternative = "two.sided", exact=FALSE) # exact=FALSE
cor.z
## 
##  Pearson's product-moment correlation
## 
## data:  ge.m and scores.m
## t = -0.35512, df = 17, p-value = 0.7269
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.5197620  0.3833394
## sample estimates:
##         cor 
## -0.08581102

# cor.z <- cor.test(formula = ~ md1 + scores, data = r11_6,
                  # method = "pearson", alternative = "two.sided", exact=FALSE) # exact=FALSE


r11.corr.ge <-ggplot(r11_6.L, aes(x=ge.m, y=scores.m)) +
  geom_point(size = 4) +
  geom_smooth(method=lm) +
  labs(x = sprintf("Global Efficiency"),
       y = sprintf("Comprehension Scores"))+
  ggtitle("Part 2 - Global Efficiency") +
  # coord_cartesian(xlim = c(-3,3), ylim = c(-3,4)) + 
  theme_bw(base_size = 15) +
  theme(axis.title = element_text(face = "bold", size = 16, color = "black"),
        axis.text = element_text(face = "plain", hjust = 0.5, size = 15, color = "black"),
        axis.line=element_line(),
        strip.text.x = element_text(face = "plain", size = 15, color = "black"),
        strip.background = element_blank(),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.border = element_blank(),
        panel.spacing=unit(1, "lines"),
        legend.position = c(0.65, 0.85),
        legend.title = element_blank(),
        aspect.ratio = 1,
        legend.background = element_blank(),
        plot.margin = margin(1, 0.5, 0.5, 0.7, "cm"),
        legend.key = element_blank())
r11.corr.ge
## `geom_smooth()` using formula 'y ~ x'

6.5.5.3 Part 1 - Modularity & Comprehension


r11_5 <- r11_2 %>% filter(check != 1) #corr == 1,
r11_6 <- r11_5 %>% filter(part == "p1", net == "All") %>% dplyr::select(sn, net,idx, part, ge, md1, scores, corr)
r11_6.L <- r11_6 %>% group_by(sn) %>% 
  dplyr::summarise(ge.m = mean(ge), m.m = mean(md1), scores.m = mean(scores)) %>% 
  ungroup()

cor.z <- cor.test(formula = ~ m.m + scores.m, data = r11_6.L,
                  method = "pearson", alternative = "two.sided", exact=FALSE) # exact=FALSE
cor.z
## 
##  Pearson's product-moment correlation
## 
## data:  m.m and scores.m
## t = -0.41793, df = 18, p-value = 0.6809
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.5180790  0.3601095
## sample estimates:
##         cor 
## -0.09803348

# cor.z <- cor.test(formula = ~ md1 + scores, data = r11_6,
                  # method = "pearson", alternative = "two.sided", exact=FALSE) # exact=FALSE


r11.corr.m <-ggplot(r11_6.L, aes(x=m.m, y=scores.m)) +
  geom_point(size = 4) +
  geom_smooth(method=lm) +
  labs(x = sprintf("Modularity"),
       y = sprintf("Comprehension Scores"))+
  ggtitle("Part 1 - Modularity") +
  # coord_cartesian(xlim = c(-3,3), ylim = c(-3,4)) + 
  theme_bw(base_size = 15) +
  theme(axis.title = element_text(face = "bold", size = 16, color = "black"),
        axis.text = element_text(face = "plain", hjust = 0.5, size = 15, color = "black"),
        axis.line=element_line(),
        strip.text.x = element_text(face = "plain", size = 15, color = "black"),
        strip.background = element_blank(),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.border = element_blank(),
        panel.spacing=unit(1, "lines"),
        legend.position = c(0.65, 0.85),
        legend.title = element_blank(),
        aspect.ratio = 1,
        legend.background = element_blank(),
        plot.margin = margin(1, 0.5, 0.5, 0.7, "cm"),
        legend.key = element_blank())
r11.corr.m
## `geom_smooth()` using formula 'y ~ x'


6.5.5.4 Part 2 - Modularity & Comprehension


r11_5 <- r11_2 %>% filter(check != 1) #corr == 1,
r11_6 <- r11_5 %>% filter(part == "p2", net == "All") %>% dplyr::select(sn, net,idx, part, ge, md1, scores, corr)
r11_6.L <- r11_6 %>% group_by(sn) %>% 
  dplyr::summarise(ge.m = mean(ge), m.m = mean(md1), scores.m = mean(scores)) %>% 
  ungroup()

cor.z <- cor.test(formula = ~ m.m + scores.m, data = r11_6.L,
                  method = "pearson", alternative = "two.sided", exact=FALSE) # exact=FALSE
cor.z
## 
##  Pearson's product-moment correlation
## 
## data:  m.m and scores.m
## t = -1.7912, df = 18, p-value = 0.0901
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.70936951  0.06471799
## sample estimates:
##        cor 
## -0.3889417


r11.corr.m <-ggplot(r11_6.L, aes(x=m.m, y=scores.m)) +
  geom_point(size = 4) +
  geom_smooth(method=lm) +
  labs(x = sprintf("Modularity"),
       y = sprintf("Comprehension Scores"))+
  ggtitle("Part 2 - Modularity") +
  # coord_cartesian(xlim = c(-3,3), ylim = c(-3,4)) + 
  theme_bw(base_size = 15) +
  theme(axis.title = element_text(face = "bold", size = 16, color = "black"),
        axis.text = element_text(face = "plain", hjust = 0.5, size = 15, color = "black"),
        axis.line=element_line(),
        strip.text.x = element_text(face = "plain", size = 15, color = "black"),
        strip.background = element_blank(),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.border = element_blank(),
        panel.spacing=unit(1, "lines"),
        legend.position = c(0.65, 0.85),
        legend.title = element_blank(),
        aspect.ratio = 1,
        legend.background = element_blank(),
        plot.margin = margin(1, 0.5, 0.5, 0.7, "cm"),
        legend.key = element_blank())
r11.corr.m
## `geom_smooth()` using formula 'y ~ x'


7 Session Info


sessionInfo()
## R version 4.1.1 (2021-08-10)
## Platform: aarch64-apple-darwin20 (64-bit)
## Running under: macOS Monterey 12.1
## 
## Matrix products: default
## BLAS:   /Library/Frameworks/R.framework/Versions/4.1-arm64/Resources/lib/libRblas.0.dylib
## LAPACK: /Library/Frameworks/R.framework/Versions/4.1-arm64/Resources/lib/libRlapack.dylib
## 
## locale:
## [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
## 
## attached base packages:
## [1] parallel  stats     graphics  grDevices utils     datasets  methods  
## [8] base     
## 
## other attached packages:
##  [1] RColorBrewer_1.1-2   ppcor_1.1            MASS_7.3-54         
##  [4] sjPlot_2.8.9         caret_6.0-88         psycho_0.6.1        
##  [7] effects_4.2-0        latticeExtra_0.6-29  ggpubr_0.4.0        
## [10] emmeans_1.6.3        lmerTest_3.1-3       afex_1.0-1          
## [13] lme4_1.1-27.1        Matrix_1.3-4         psych_2.1.9         
## [16] car_3.0-11           carData_3.0-4        knitr_1.37          
## [19] forcats_0.5.1        stringr_1.4.0        dplyr_1.0.7         
## [22] purrr_0.3.4          readr_2.0.1          tidyr_1.1.3         
## [25] tibble_3.1.4         tidyverse_1.3.1      ggbeeswarm_0.6.0    
## [28] ggplot2_3.3.5        effectsize_0.4.5     lsr_0.5.1           
## [31] effsize_0.8.1        rstatix_0.7.0        Rmisc_1.5           
## [34] plyr_1.8.6           lattice_0.20-44      pacman_0.5.1        
## [37] klippy_0.0.0.9500    patchwork_1.1.0.9000 papaja_0.1.0.9997   
## [40] devtools_2.4.2       usethis_2.0.1        distill_1.2         
## 
## loaded via a namespace (and not attached):
##   [1] utf8_1.2.2           tidyselect_1.1.1     grid_4.1.1          
##   [4] pROC_1.18.0          munsell_0.5.0        codetools_0.2-18    
##   [7] future_1.22.1        withr_2.4.3          colorspace_2.0-2    
##  [10] highr_0.9            rstudioapi_0.13      stats4_4.1.1        
##  [13] ggsignif_0.6.3       listenv_0.8.0        labeling_0.4.2      
##  [16] mnormt_2.0.2         farver_2.1.0         datawizard_0.2.0.1  
##  [19] rprojroot_2.0.2      coda_0.19-4          parallelly_1.28.1   
##  [22] vctrs_0.3.8          generics_0.1.0       TH.data_1.1-0       
##  [25] ipred_0.9-12         xfun_0.29            R6_2.5.1            
##  [28] cachem_1.0.6         assertthat_0.2.1     scales_1.1.1        
##  [31] multcomp_1.4-18      nnet_7.3-16          beeswarm_0.4.0      
##  [34] gtable_0.3.0         downlit_0.2.1        globals_0.14.0      
##  [37] processx_3.5.2       sandwich_3.0-1       timeDate_3043.102   
##  [40] rlang_0.4.12         splines_4.1.1        ModelMetrics_1.2.2.2
##  [43] broom_0.7.9.9000     yaml_2.2.1           reshape2_1.4.4      
##  [46] abind_1.4-5          modelr_0.1.8         backports_1.2.1     
##  [49] tools_4.1.1          lava_1.6.10          ellipsis_0.3.2      
##  [52] jquerylib_0.1.4      sessioninfo_1.1.1    Rcpp_1.0.7          
##  [55] ps_1.6.0             prettyunits_1.1.1    rpart_4.1-15        
##  [58] cowplot_1.1.1        zoo_1.8-9            haven_2.4.3         
##  [61] fs_1.5.0             survey_4.1-1         magrittr_2.0.1      
##  [64] data.table_1.14.0    openxlsx_4.2.4       reprex_2.0.1        
##  [67] tmvnsim_1.0-2        mvtnorm_1.1-2        sjmisc_2.8.7        
##  [70] pkgload_1.2.2        hms_1.1.0            evaluate_0.14       
##  [73] xtable_1.8-4         sjstats_0.18.1       rio_0.5.27          
##  [76] jpeg_0.1-9           readxl_1.3.1         ggeffects_1.1.1     
##  [79] testthat_3.0.4       compiler_4.1.1       crayon_1.4.2        
##  [82] minqa_1.2.4          htmltools_0.5.2      mgcv_1.8-36         
##  [85] tzdb_0.1.2           lubridate_1.7.10     DBI_1.1.1           
##  [88] sjlabelled_1.1.8     dbplyr_2.1.1         boot_1.3-28         
##  [91] cli_3.1.0            mitools_2.4          insight_0.14.4      
##  [94] gower_0.2.2          pkgconfig_2.0.3      numDeriv_2016.8-1.1 
##  [97] foreign_0.8-81       recipes_0.1.16       xml2_1.3.3          
## [100] foreach_1.5.1        vipor_0.4.5          estimability_1.3    
## [103] prodlim_2019.11.13   rvest_1.0.1          callr_3.7.0         
## [106] digest_0.6.29        parameters_0.14.0    rmarkdown_2.11      
## [109] cellranger_1.1.0     curl_4.3.2           nloptr_1.2.2.2      
## [112] lifecycle_1.0.0      nlme_3.1-152         jsonlite_1.7.2      
## [115] desc_1.3.0           fansi_0.5.0          pillar_1.6.2        
## [118] fastmap_1.1.0        httr_1.4.2           pkgbuild_1.2.0      
## [121] survival_3.2-11      glue_1.6.0           remotes_2.4.0       
## [124] bayestestR_0.11.0    zip_2.2.0            png_0.1-7           
## [127] iterators_1.0.13     performance_0.7.3    class_7.3-19        
## [130] stringi_1.7.6        memoise_2.0.0        future.apply_1.8.1